mlton-commit — [MLton-commit] Code commits

[MLton-commit] r4011 - mlton/trunk/ide/emacs

[<ve...@ml...>]

Author: vesak
Date: 2005-08-20 03:09:26 -0700 (Sat, 20 Aug 2005)
New Revision: 4011

Modified:
   mlton/trunk/ide/emacs/esml-gen.el
   mlton/trunk/ide/emacs/esml-mlb-mode.el
   mlton/trunk/ide/emacs/esml-util.el
Log:
Support <longstrid> as an annotation value.  Proper completion of paths
starting with "../".  No longer using eval-when-compile with require as
it makes compiled files unusable.


Modified: mlton/trunk/ide/emacs/esml-gen.el
===================================================================
--- mlton/trunk/ide/emacs/esml-gen.el	2005-08-20 03:43:25 UTC (rev 4010)
+++ mlton/trunk/ide/emacs/esml-gen.el	2005-08-20 10:09:26 UTC (rev 4011)
@@ -3,9 +3,8 @@
 ;; MLton is released under a BSD-style license.
 ;; See the file MLton-LICENSE for details.
 
-(eval-when-compile
-  (require 'cl)
-  (require 'esml-util))
+(require 'cl)
+(require 'esml-util)
 
 ;; Installation
 ;; ============

Modified: mlton/trunk/ide/emacs/esml-mlb-mode.el
===================================================================
--- mlton/trunk/ide/emacs/esml-mlb-mode.el	2005-08-20 03:43:25 UTC (rev 4010)
+++ mlton/trunk/ide/emacs/esml-mlb-mode.el	2005-08-20 10:09:26 UTC (rev 4011)
@@ -3,9 +3,8 @@
 ;; MLton is released under a BSD-style license.
 ;; See the file MLton-LICENSE for details.
 
-(eval-when-compile
-  (require 'cl)
-  (require 'esml-util))
+(require 'cl)
+(require 'esml-util)
 
 ;; Emacs mode for editing ML Basis files
 ;;
@@ -71,7 +70,7 @@
     ("allowPrim" "false" "true")
     ("allowRebindEquals" "false" "true")
     ("deadCode" "false" "true")
-    ("ffiStr" "[A-Za-z0-9_]*")
+    ("ffiStr" "<longstrid>")
     ("forceUsed")
     ("nonexhaustiveExnMatch" "default" "ignore")
     ("nonexhaustiveMatch" "warn" "ignore" "error")
@@ -82,7 +81,7 @@
   :type '(repeat (cons :tag "Annotation"
                        (string :tag "Name")
                        (repeat :tag "Values starting with the default"
-                               regexp)))
+                               string)))
   :set 'esml-mlb-set-custom-and-update
   :group 'esml-mlb)
 
@@ -166,10 +165,7 @@
                                                (apply 'call-process
                                                       (car cmd-and-args) nil t nil (cdr cmd-and-args)))
                                            (error -1)))
-                                        (esml-replace-regexp-in-string
-                                         (buffer-string)
-                                         "{[ \t]*None[ \t]*|[ \t]*Some[ \t]*<[^>]+>}"
-                                         "{[A-Za-z0-9_]*}")
+                                        (buffer-string)
                                       (message "Show annotations command failed.")
                                       ""))
                                   "[ \t]*\n+[ \t]*"))))
@@ -241,6 +237,14 @@
 (defconst esml-mlb-unquoted-path-or-ref-chars
   (concat esml-mlb-unquoted-path-chars "()$"))
 
+(defun esml-mlb-<token>-to-regexp (<token>)
+  (let* ((<token>-to-regexp
+          '(("<longstrid>" . "[A-Za-z0-9_]*")))
+         (<token>-regexp (assoc <token> <token>-to-regexp)))
+    (if <token>-regexp
+        (cdr <token>-regexp)
+      <token>)))
+
 (defconst esml-mlb-keywords
   '("and" "ann" "bas" "basis" "end" "functor" "in" "let" "local" "open"
     "signature" "structure")
@@ -293,9 +297,14 @@
                            (concat (car name-values) "[ \t\n]+\\("
                                    (reduce (function
                                             (lambda (r s)
-                                              (concat r "\\|\\(" s "\\)")))
+                                              (concat r "\\|\\("
+                                                      (esml-mlb-<token>-to-regexp s)
+                                                      "\\)")))
                                            (cddr name-values)
-                                           :initial-value (concat "\\(" (cadr name-values) "\\)"))
+                                           :initial-value (concat "\\("
+                                                                  (esml-mlb-<token>-to-regexp
+                                                                   (cadr name-values))
+                                                                  "\\)"))
                                    "\\)")
                          (car name-values))
                        regexps)))
@@ -443,13 +452,17 @@
    ((esml-point-preceded-by (concat "\"[ \t\n]*\\("
                                     (regexp-opt (mapcar 'car esml-mlb-annotations))
                                     "\\)[ \t\n]+\\(" esml-mlb-str-chr-regexp "*\\)"))
-    ;; TBD: do not auto-complete non-trivial regexps
     (let* ((annot (assoc (match-string 1) esml-mlb-annotations))
-           (values (cdr annot))
+           (all-values (cdr annot))
+           (values (remove* nil all-values
+                            :test (function
+                                   (lambda (_ s)
+                                     (and (< 0 (length s))
+                                          (= ?< (aref s 0)))))))
            (value-prefix (match-string 2))
            (value-completion (try-completion value-prefix (mapcar 'list values)))
            (value (if (eq t value-completion) value-prefix value-completion)))
-      (message "Annotation: %s %s" (car annot) (if values values ""))
+      (message "Annotation: %s %s" (car annot) (if all-values all-values ""))
       (when (stringp value-completion)
         (esml-insert-or-skip-if-looking-at
          (substring value (length value-prefix))))
@@ -526,7 +539,9 @@
                                      nondir-prefix
                                      (mapcar 'list esml-mlb-keywords))
                                     files))
-                        (esml-mlb-filter-file-completions files)))))
+                        (esml-mlb-filter-file-completions
+                         files
+                         (esml-string-matches-p "\\(\.\./\\)+" dir))))))
            (nondir-completion (try-completion nondir-prefix nondir-completions))
            (nondir (if (eq t nondir-completion)
                        nondir-prefix
@@ -541,10 +556,10 @@
         (if (eq t (try-completion nondir nondir-completions))
             (cond ((file-name-directory nondir)
                    (message "Completions: %s"
-                            (sort (esml-mlb-filter-file-completions
-                                   (file-name-all-completions
-                                    ""
-                                    (concat dir nondir)))
+                            (sort (let ((dir (concat dir nondir)))
+                                    (esml-mlb-filter-file-completions
+                                     (file-name-all-completions "" dir)
+                                     (esml-string-matches-p "\\(\.\./\\)+" dir)))
                                   'string-lessp)))
                   ((member nondir esml-mlb-keywords)
                    (esml-mlb-indent-line)

Modified: mlton/trunk/ide/emacs/esml-util.el
===================================================================
--- mlton/trunk/ide/emacs/esml-util.el	2005-08-20 03:43:25 UTC (rev 4010)
+++ mlton/trunk/ide/emacs/esml-util.el	2005-08-20 10:09:26 UTC (rev 4011)
@@ -3,8 +3,7 @@
 ;; MLton is released under a BSD-style license.
 ;; See the file MLton-LICENSE for details.
 
-(eval-when-compile
-  (require 'cl))
+(require 'cl)
 
 ;; Some general purpose Emacs Lisp utility functions
 
@@ -34,19 +33,23 @@
     (insert str)))
 
 ;; workaround for incompatibility between GNU Emacs and XEmacs
-(if (string-match "XEmacs" emacs-version)
-    (defun esml-split-string (string separator)
-      (split-string string separator t))
-  (defun esml-split-string (string separator)
+(defun esml-split-string (string separator)
+  (if (string-match "XEmacs" emacs-version)
+      (split-string string separator t)
     (remove* "" (split-string string separator))))
 
 ;; workaround for incompatibility between GNU Emacs and XEmacs
-(if (string-match "XEmacs" emacs-version)
-    (defun esml-replace-regexp-in-string (str regexp rep)
-      (replace-in-string str regexp rep t))
-  (defun esml-replace-regexp-in-string (str regexp rep)
+(defun esml-replace-regexp-in-string (str regexp rep)
+  (if (string-match "XEmacs" emacs-version)
+      (replace-in-string str regexp rep t)
     (replace-regexp-in-string regexp rep str t t)))
 
+(defun esml-string-matches-p (regexp str)
+  "Non-nil iff the entire string matches the regexp."
+  (and (string-match regexp str)
+       (= 0 (match-beginning 0))
+       (= (length str) (match-end 0))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (provide 'esml-util)

[MLton-commit] r4010 - mlton/trunk/bin

[Stephen W. <sw...@ml...>]

Author: sweeks
Date: 2005-08-19 20:43:25 -0700 (Fri, 19 Aug 2005)
New Revision: 4010

Removed:
   mlton/trunk/bin/check-basis
Log:
Removed long unused script.


Deleted: mlton/trunk/bin/check-basis
===================================================================
--- mlton/trunk/bin/check-basis	2005-08-20 02:43:45 UTC (rev 4009)
+++ mlton/trunk/bin/check-basis	2005-08-20 03:43:25 UTC (rev 4010)
@@ -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

[MLton-commit] r4009 - mlton/trunk/bin

[Stephen W. <sw...@ml...>]

Author: sweeks
Date: 2005-08-19 19:43:45 -0700 (Fri, 19 Aug 2005)
New Revision: 4009

Modified:
   mlton/trunk/bin/mlton-script
Log:
Make sure $lib is an absolute path, even in build/bin/mlton.


Modified: mlton/trunk/bin/mlton-script
===================================================================
--- mlton/trunk/bin/mlton-script	2005-08-20 02:21:01 UTC (rev 4008)
+++ mlton/trunk/bin/mlton-script	2005-08-20 02:43:45 UTC (rev 4009)
@@ -4,7 +4,8 @@
 
 set -e
 
-lib='lib unset'
+dir=`dirname $0`
+lib=`cd $dir/../lib && pwd`
 gcc='gcc'
 mlton="$lib/mlton-compile"
 world="$lib/world.mlton"

[MLton-commit] r4008 - mlton/trunk/mlton/control

[Stephen W. <sw...@ml...>]

Author: sweeks
Date: 2005-08-19 19:21:01 -0700 (Fri, 19 Aug 2005)
New Revision: 4008

Modified:
   mlton/trunk/mlton/control/control-flags.sml
Log:
Fixed -show-anns output for ffiStr and forceUsed.


Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml	2005-08-19 21:34:15 UTC (rev 4007)
+++ mlton/trunk/mlton/control/control-flags.sml	2005-08-20 02:21:01 UTC (rev 4008)
@@ -179,7 +179,7 @@
 	 fn Good z => z
 	  | _ => Error.bug "Control.Elaborate.deGood"
 
-      val documentation: {choices: string list,
+      val documentation: {choices: string list option,
                           expert: bool,
                           name: string} list ref = ref []
 
@@ -198,13 +198,16 @@
             (List.map
              (all, fn {choices, name, ...} =>
               str (concat [name,
-                           " {",
-                           concat (List.separate (choices, "|")),
-                           "}"])))
+                           case choices of
+                              NONE => ""
+                            | SOME cs =>
+                                 concat [" {",
+                                         concat (List.separate (cs, "|")),
+                                         "}"]])))
          end
          
       local 
-	 fun make ({choices: 'st list,
+	 fun make ({choices: 'st list option,
                     default: 'st,
 		    expert: bool,
 		    toString: 'st -> string,
@@ -220,7 +223,8 @@
                val () =
                   List.push
                   (documentation,
-                   {choices = List.map (choices, toString),
+                   {choices = Option.map (choices, fn cs =>
+                                          List.map (cs, toString)),
                     expert = expert,
                     name = name})
 	       val ctrl as T {args = argsRef, cur, def, 
@@ -319,7 +323,8 @@
 	 fun makeBool ({default: bool,
 			expert: bool,
 			name: string}, ac) =
-	    make ({choices = if default then [true, false] else [false, true],
+	    make ({choices = SOME (if default then [true, false]
+                                   else [false, true]),
                    default = default,
 		   expert = expert,
 		   toString = Bool.toString,
@@ -353,14 +358,15 @@
 	 fun makeDiagEIW ({default: DiagEIW.t,
 			   expert: bool,
 			   name: string}, ac) =
-	    makeDiagnostic ({choices = let
-                                          datatype z = datatype DiagEIW.t
-                                       in
-                                          case default of
-                                             Error => [Error, Ignore, Warn]
-                                           | Ignore => [Ignore, Error, Warn]
-                                           | Warn => [Warn, Ignore, Error]
-                                       end,
+	    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,
@@ -369,13 +375,14 @@
 	 fun makeDiagDI ({default: DiagDI.t,
 			  expert: bool,
 			  name: string}, ac) =
-	    makeDiagnostic ({choices = let
-                                          datatype z = datatype DiagDI.t
-                                       in
-                                          case default of
-                                             Default => [Default, Ignore]
-                                           | Ignore => [Ignore, Default]
-                                       end,
+	    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,
@@ -406,7 +413,7 @@
 	    makeBool ({name = "deadCode", 
 		       default = false, expert = false}, ac)
 	 val (forceUsed, ac) =
-	    make ({choices = [false, true],
+	    make ({choices = NONE,
                    default = false,
 		   expert = false,
 		   toString = Bool.toString,
@@ -419,10 +426,10 @@
 				| _ => NONE},
 		  ac)
 	 val (ffiStr, ac) =
-	    make ({choices = [NONE, SOME "<longstrid>"],
+	    make ({choices = SOME [SOME "<longstrid>"],
                    default = NONE,
 		   expert = true,
-		   toString = Option.toString String.toString,
+		   toString = fn NONE => "" | SOME s => s,
 		   name = "ffiStr",
 		   newCur = fn (_,s) => SOME s,
 		   newDef = fn _ => NONE,

[MLton-commit] commit email: r4007 - mlton/trunk

[Stephen W. <sw...@ml...>]

Author: sweeks
Date: 2005-08-19 14:34:15 -0700 (Fri, 19 Aug 2005)
New Revision: 4007

Modified:
   mlton/trunk/Makefile
Log:
MAIL commit email

This commit should demonstrate that commit emails work again.  As
before, commit email will only be sent to ML...@ml... if the first
line of the log entry starts with "MAIL ".

I also added a mailing list, MLt...@ml..., for those who
want to receive an email of every commit.  You can sign up and see the
archives at

  http://mlton.org/mailman/listinfo/mlton-commit

MLton-commit is a read-only list.  Any discussion should go to
ML...@ml....



Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile	2005-08-19 21:10:24 UTC (rev 4006)
+++ mlton/trunk/Makefile	2005-08-19 21:34:15 UTC (rev 4007)
@@ -4,7 +4,7 @@
  #
  # 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)

[MLton-commit] r4006 - mlton/trunk

[Stephen W. <sw...@ml...>]

Author: sweeks
Date: 2005-08-19 14:10:24 -0700 (Fri, 19 Aug 2005)
New Revision: 4006

Modified:
   mlton/trunk/Makefile
Log:
Changed to see commit email work.


Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile	2005-08-19 20:10:49 UTC (rev 4005)
+++ mlton/trunk/Makefile	2005-08-19 21:10:24 UTC (rev 4006)
@@ -4,7 +4,7 @@
  #
  # 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)

[MLton-commit] r4005 - mlton/trunk

[<ML...@ml...>]

Author: sweeks
Date: 2005-08-19 13:10:49 -0700 (Fri, 19 Aug 2005)
New Revision: 4005

Modified:
   mlton/trunk/Makefile
Log:
Changing just to test commit email.


Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile	2005-08-19 16:00:31 UTC (rev 4004)
+++ mlton/trunk/Makefile	2005-08-19 20:10:49 UTC (rev 4005)
@@ -4,7 +4,7 @@
  #
  # 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)

[MLton-commit] r4005 - mlton/trunk

[<ML...@ml...>]

Author: sweeks
Date: 2005-08-19 13:10:49 -0700 (Fri, 19 Aug 2005)
New Revision: 4005

Modified:
   mlton/trunk/Makefile
Log:
Changing just to test commit email.


Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile	2005-08-19 16:00:31 UTC (rev 4004)
+++ mlton/trunk/Makefile	2005-08-19 20:10:49 UTC (rev 4005)
@@ -4,7 +4,7 @@
  #
  # 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)

[MLton-commit] test

[<ML...@ml...>]