[MLton] cvs commit: support for constants defined on the command-line

Stephen Weeks sweeks@mlton.org
Wed, 15 Sep 2004 11:16:30 -0700


sweeks      04/09/15 11:16:29

  Modified:    basis-library/misc primitive.sml
               bin      regression
               doc/user-guide man-page.tex
               man      mlton.1
               mlton/ast ast-core.fun ast-core.sig sources.mlb
               mlton/atoms const.fun const.sig sources.cm sources.mlb
               mlton/control control.sig control.sml
               mlton/elaborate elaborate-core.fun elaborate-core.sig
                        elaborate-mlbs.fun elaborate-mlbs.sig
                        elaborate-modules.fun elaborate-modules.sig
                        elaborate-programs.fun elaborate-programs.sig
                        elaborate.fun elaborate.sig sources.cm sources.mlb
               mlton/front-end ml.grm ml.lex
               mlton/main compile.fun compile.sig lookup-constant.fun
                        lookup-constant.sig main.fun
  Added:       mlton/atoms const-type.fun const-type.sig
  Removed:     mlton/elaborate const-type.sig
  Log:
  MAIL support for constants defined on the command-line
  
  Added command-line switch "-const '<name> <value>'", which is used to
  set the value of constants defined in SML by _command_line_const.  The
  syntax is
  
  	_command_line_const "<name>": <ty> = <const>;
  
  This is now used for constants
  
  	Exn.keepHistory, MLton.safe, MLton.size, TextIO.bufSize
  
  The -const switch replaces the following, which are now expert and
  deprecated:
  
  	-detect-overflow
  	-exn-history
  	-safe
  	-text-io-buf-size
  
  One annoyance is that the value of exnHistory is used inside the
  compiler itself, in the implement exceptions pass.  Perhaps this could
  be removed, but it's not obvious.  In any case, there is a little
  hardwired code that sets the value of Control.exnHistory based on the
  value of "Exn.keepHistory".  I don't think this is any worse than
  before, when we had hardwired code to set the build constant named
  "Exn_history" based on the value of Control.exnHistory.  The other
  three constants were unused in the compiler, so their control was
  removed.

Revision  Changes    Path
1.121     +6 -4      mlton/basis-library/misc/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.120
retrieving revision 1.121
diff -u -r1.120 -r1.121
--- primitive.sml	7 Sep 2004 01:16:50 -0000	1.120
+++ primitive.sml	15 Sep 2004 18:16:26 -0000	1.121
@@ -155,12 +155,13 @@
 
 structure Primitive =
    struct
-      val detectOverflow = _build_const "MLton_detectOverflow": bool;
+      val detectOverflow =
+	 _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;
-      val safe = _build_const "MLton_safe": bool;
+      val safe = _command_line_const "MLton.safe": bool = true;
       val touch = _prim "MLton_touch": 'a -> unit;
       val usesCallcc: bool ref = ref false;
 
@@ -250,7 +251,8 @@
 	    val extra = _prim "Exn_extra": exn -> 'a;
 	    val extra: exn -> extra = extra
 	    val name = _prim "Exn_name": exn -> string;
-	    val keepHistory = _build_const "Exn_keepHistory": bool;
+	    val keepHistory =
+	       _command_line_const "Exn.keepHistory": bool = false;
 	    val setExtendExtra =
 	       _prim "Exn_setExtendExtra": (string * 'a -> 'a) -> unit;
 	    val setExtendExtra: (string * extra -> extra) -> unit =
@@ -1384,7 +1386,7 @@
 
       structure TextIO =
 	 struct
-	    val bufSize = _build_const "TextIO_bufSize": int;
+	    val bufSize = _command_line_const "TextIO.bufSize": int = 4096;
 	 end
       
       structure Thread =



1.97      +1 -1      mlton/bin/regression

Index: regression
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/regression,v
retrieving revision 1.96
retrieving revision 1.97
diff -u -r1.96 -r1.97
--- regression	27 Aug 2004 00:50:42 -0000	1.96
+++ regression	15 Sep 2004 18:16:26 -0000	1.97
@@ -97,7 +97,7 @@
 		echo "testing $f"
 		case "$f" in
 		exnHistory*)
-			extraFlags="-exn-history true"
+			extraFlags="-const 'Exn.keepHistory true'"
 		;;
 		*)
 			extraFlags=""



1.59      +15 -6     mlton/doc/user-guide/man-page.tex

Index: man-page.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/man-page.tex,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -r1.58 -r1.59
--- man-page.tex	6 Sep 2004 05:15:49 -0000	1.58
+++ man-page.tex	15 Sep 2004 18:16:26 -0000	1.59
@@ -58,6 +58,21 @@
 With {\tt -codegen native}, {\mlton} typically compiles more quickly and
 generates better code.
 
+\option{-const '{\it name} {\it value}'}
+Set the value of a compile-time constant.  Here is a list of available
+constants, their default values, and what they control.
+
+\vspace{0em} % this is here to make hevea generate a blank line
+\begin{description}
+
+\option{Exn.keepHistory \falseTrue}
+Enable {\tt Exn.history}.  See \secref{exn} for details.  There is a
+performance cost to setting this to {\tt true}, 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.
+
+\end{description}
+
 \option{-default-ann {\it anns}}
 Specify the default annotation values for {\tt mlb} files.  For
 example, {\tt -default-ann 'warnUnused true'} causes unused variable
@@ -71,12 +86,6 @@
 supply multiple annotations separated by commas.  For example, to see
 {\em all} match and unused warnings, use {\tt -disable-ann 'warnMatch,
 warnUnused, forceUsed' -default-ann 'warnUnused true'}.
-
-\option{-exn-history \falseTrue}
-Enable {\tt Exn.history}.  See \secref{exn} for details.  There is a
-performance cost to {\tt -exn-history true}, 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.
 
 \option{-export-header {\it file}}
 Write to {\it file} C prototypes for all of the functions exported



1.52      +13 -7     mlton/man/mlton.1

Index: mlton.1
===================================================================
RCS file: /cvsroot/mlton/mlton/man/mlton.1,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- mlton.1	6 Sep 2004 05:15:49 -0000	1.51
+++ mlton.1	15 Sep 2004 18:16:26 -0000	1.52
@@ -61,6 +61,19 @@
 better code.
 
 .TP
+\fB-const '\fIname value\fP'\fR
+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
+.in +.5i
+Enable \fBExn.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 \fIanns\fR
 Specify the default annotation values for \fBmlb\fP files.  For
 example, \fB-default-ann 'warnUnused true'\fP 
@@ -76,13 +89,6 @@
 \fIall\fP match and unused warnings, use 
 \fB-disable-ann 'warnMatch, warnUnused, forceUsed' -default-ann
 'warnUnused true'\fP.
-
-.TP
-\fB-exn-history \fI{\fBfalse\fI|\fBtrue\fI}\fR
-Enable \fBExn.history\fP.  There is a performance cost to
-\fB-exn-history true\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. 
 
 .TP
 \fB-export-header \fIfile\fR



1.29      +1 -0      mlton/mlton/ast/ast-core.fun

Index: ast-core.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/ast-core.fun,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- ast-core.fun	14 Aug 2004 01:34:51 -0000	1.28
+++ ast-core.fun	15 Sep 2004 18:16:26 -0000	1.29
@@ -272,6 +272,7 @@
 
       datatype t =
 	 BuildConst
+       | CommandLineConst of {value: Const.t}
        | Const
        | Export of Attribute.t list
        | Import of Attribute.t list



1.18      +1 -0      mlton/mlton/ast/ast-core.sig

Index: ast-core.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/ast-core.sig,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- ast-core.sig	13 Aug 2004 23:53:34 -0000	1.17
+++ ast-core.sig	15 Sep 2004 18:16:26 -0000	1.18
@@ -94,6 +94,7 @@
 	    
 	    datatype t =
 	       BuildConst
+	     | CommandLineConst of {value: Const.t}
 	     | Const
 	     | Export of Attribute.t list
 	     | Import of Attribute.t list



1.2       +1 -1      mlton/mlton/ast/sources.mlb

Index: sources.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/sources.mlb,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- sources.mlb	14 Aug 2004 12:39:11 -0000	1.1
+++ sources.mlb	15 Sep 2004 18:16:26 -0000	1.2
@@ -75,4 +75,4 @@
     functor Symbol
     functor TyconKind
     functor Tyvar
-end
\ No newline at end of file
+end



1.19      +8 -2      mlton/mlton/atoms/const.fun

Index: const.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/const.fun,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- const.fun	1 May 2004 00:49:34 -0000	1.18
+++ const.fun	15 Sep 2004 18:16:26 -0000	1.19
@@ -1,15 +1,18 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 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.
  *)
+
 functor Const (S: CONST_STRUCTS): CONST = 
 struct
 
 open S
 
+structure ConstType = ConstType ()
+
 structure SmallIntInf =
    struct
       structure Word = Pervasive.Word
@@ -74,5 +77,8 @@
     | _ => false
 
 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")
+
 end



1.13      +7 -0      mlton/mlton/atoms/const.sig

Index: const.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/const.sig,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- const.sig	1 May 2004 00:49:34 -0000	1.12
+++ const.sig	15 Sep 2004 18:16:27 -0000	1.13
@@ -17,6 +17,8 @@
    sig
       include CONST_STRUCTS
 
+      structure ConstType: CONST_TYPE
+
       structure SmallIntInf:
 	 sig
 	    val fromWord: word -> IntInf.t
@@ -34,6 +36,11 @@
       val intInf: IntInf.t -> t
       val hash: t -> word
       val layout: t -> Layout.t
+      (* lookup is for constants defined by _const, _build_const, and
+       * _command_line_const.  It is set in main/compile.fun.
+       *)
+      val lookup: ({default: string option,
+		    name: string} * ConstType.t -> t) ref
       val real: RealX.t -> t
       val string: string -> t
       val toString: t -> string



1.24      +3 -0      mlton/mlton/atoms/sources.cm

Index: sources.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/sources.cm,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- sources.cm	1 May 2004 00:49:34 -0000	1.23
+++ sources.cm	15 Sep 2004 18:16:27 -0000	1.24
@@ -14,6 +14,7 @@
 signature C_TYPE
 signature CON
 signature CONST
+signature CONST_TYPE
 signature FFI
 signature GENERIC_SCHEME
 signature ID
@@ -58,6 +59,8 @@
 label.sig
 c-function.sig
 c-function.fun
+const-type.sig
+const-type.fun
 const.sig
 const.fun
 prim.sig



1.2       +3 -1      mlton/mlton/atoms/sources.mlb

Index: sources.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/sources.mlb,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- sources.mlb	14 Aug 2004 12:39:12 -0000	1.1
+++ sources.mlb	15 Sep 2004 18:16:27 -0000	1.2
@@ -24,6 +24,7 @@
     label.sig
     c-function.sig
     c-function.fun
+    const-type.sig
     const.sig
     const.fun
     prim.sig
@@ -58,6 +59,7 @@
     signature C_TYPE
     signature CON
     signature CONST
+    signature CONST_TYPE
     signature FFI
     signature GENERIC_SCHEME
     signature ID
@@ -81,4 +83,4 @@
     functor HashType
     functor TypeOps
     functor UseName
-end
\ No newline at end of file
+end



1.1                  mlton/mlton/atoms/const-type.fun

Index: const-type.fun
===================================================================
(* Copyright (C) 1999-2004 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.
 *)

functor ConstType (S: CONST_TYPE_STRUCTS): CONST_TYPE =
struct

datatype t = Bool | Real | String | Word

val toString =
   fn Bool => "Bool"
    | Real => "Real"
    | String => "String"
    | Word => "Word"
	 
end



1.1                  mlton/mlton/atoms/const-type.sig

Index: const-type.sig
===================================================================
(* Copyright (C) 1999-2004 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.
 *)

signature CONST_TYPE_STRUCTS =
   sig
   end

signature CONST_TYPE =
   sig
      include CONST_TYPE_STRUCTS
	 
      datatype t = Bool | Real | String | Word

      val toString: t -> string
   end



1.110     +0 -8      mlton/mlton/control/control.sig

Index: control.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sig,v
retrieving revision 1.109
retrieving revision 1.110
diff -u -r1.109 -r1.110
--- control.sig	9 Sep 2004 03:45:44 -0000	1.109
+++ control.sig	15 Sep 2004 18:16:27 -0000	1.110
@@ -52,9 +52,6 @@
 
       val defines: string list ref
 
-      (* whether the arithmetic primitives detect overflow *)
-      val detectOverflow: bool ref
-
       (* List of pass names to keep diagnostic info on. *)
       val diagPasses: Regexp.Compiled.t list ref
 
@@ -256,9 +253,6 @@
 
       val reserveEsp: bool option ref
 
-      (* Array bounds checking. *)
-      val safe: bool ref
-
       (* Show the basis library. *)
       val showBasis: File.t option ref
 	 
@@ -297,8 +291,6 @@
       datatype os = datatype MLton.Platform.OS.t
       val targetOS: os ref
 
-      val textIOBufSize: int ref
-	 
       (* Type check ILs. *)
       val typeCheck: bool ref
 



1.141     +0 -12     mlton/mlton/control/control.sml

Index: control.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sml,v
retrieving revision 1.140
retrieving revision 1.141
diff -u -r1.140 -r1.141
--- control.sml	9 Sep 2004 03:45:44 -0000	1.140
+++ control.sml	15 Sep 2004 18:16:27 -0000	1.141
@@ -91,10 +91,6 @@
 		       default = [],
 		       toString = List.toString String.toString}
 
-val detectOverflow = control {name = "detect overflow",
-			      default = true,
-			      toString = Bool.toString}
-
 val diagPasses = 
    control {name = "diag passes",
 	    default = [],
@@ -600,10 +596,6 @@
 			  default = NONE,
 			  toString = Option.toString Bool.toString}
 
-val safe = control {name = "safe",
-		    default = true,
-		    toString = Bool.toString}
-
 val showBasis = control {name = "show basis",
 			 default = NONE,
 			 toString = Option.toString File.toString}
@@ -683,10 +675,6 @@
 val targetOS = control {name = "target OS",
 			default = Linux,
 			toString = MLton.Platform.OS.toString}
-
-val textIOBufSize = control {name = "TextIO buffer size",
-			     default = 4096,
-			     toString = Int.toString}
 
 val typeCheck = control {name = "type check",
 			 default = false,



1.122     +25 -9     mlton/mlton/elaborate/elaborate-core.fun

Index: elaborate-core.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-core.fun,v
retrieving revision 1.121
retrieving revision 1.122
diff -u -r1.121 -r1.122
--- elaborate-core.fun	9 Sep 2004 03:45:45 -0000	1.121
+++ elaborate-core.fun	15 Sep 2004 18:16:27 -0000	1.122
@@ -5,6 +5,7 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
+
 functor ElaborateCore (S: ELABORATE_CORE_STRUCTS): ELABORATE_CORE = 
 struct
 
@@ -22,8 +23,6 @@
    val sequenceUnit = fn () => current sequenceUnit
    val warnMatch = fn () => current warnMatch
 end
-val lookupConstant : (string * ConstType.t -> CoreML.Const.t) ref = 
-   ref (fn _ => Error.bug "lookupConstant not set")
 
 local
    open Ast
@@ -81,6 +80,7 @@
    structure Convention	 = CFunction.Convention	
    structure Con = Con
    structure Const = Const
+   structure ConstType = Const.ConstType
    structure Cdec = Dec
    structure Cexp = Exp
    structure Ffi = Ffi
@@ -2102,7 +2102,7 @@
 		   in
 		      Cexp.orElse (ce, ce')
 		   end
-	      | Aexp.Prim {kind, name, ty} =>
+	      | Aexp.Prim {kind, name, ty} => 
 		   let
 		      val ty = elabType ty
 		      val expandedTy =
@@ -2185,7 +2185,7 @@
 							   mayInline = true}),
 					     ty)
 			       end
-		      fun lookConst (name: string) =
+		      fun lookConst {default: string option, name: string} =
 			 let
 			    fun bug () =
 			       let
@@ -2225,9 +2225,8 @@
 					     else
 						bug ()
 				  val finish =
-				     let val lookupConstant = !lookupConstant
-				     in fn () => lookupConstant (name, ct)
-				     end
+				     fn () => ! Const.lookup ({default = default,
+							       name = name}, ct)
 			       in
 				  Cexp.make (Cexp.Const finish, ty)
 			       end
@@ -2238,10 +2237,27 @@
 		      case kind of
 			 BuildConst =>
 			    (check (ElabControl.allowConstant, "_build_const")
-			     ; lookConst name)
+			     ; lookConst {default = NONE, name = name})
+		       | CommandLineConst {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 => 
 			    (check (ElabControl.allowConstant, "_const")
-			     ; lookConst name)
+			     ; lookConst {default = NONE, name = name})
 		       | Export attributes =>
 			    (check (ElabControl.allowExport, "_export")
 			     ; let



1.11      +2 -5      mlton/mlton/elaborate/elaborate-core.sig

Index: elaborate-core.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-core.sig,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- elaborate-core.sig	4 Aug 2004 03:15:09 -0000	1.10
+++ elaborate-core.sig	15 Sep 2004 18:16:27 -0000	1.11
@@ -5,12 +5,12 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
+
 type int = Int.t
 
 signature ELABORATE_CORE_STRUCTS = 
    sig
       structure Ast: AST
-      structure ConstType: CONST_TYPE
       structure CoreML: CORE_ML
       structure Decs: DECS
       structure Env: ELABORATE_ENV
@@ -25,9 +25,6 @@
       include ELABORATE_CORE_STRUCTS
 
       (* Elaborate dec in env, returning Core ML decs. *)
-      val elaborateDec:
-	 Ast.Dec.t * {env: Env.t, nest: string list}
-	 -> Decs.t
-      val lookupConstant: (string * ConstType.t -> CoreML.Const.t) ref
+      val elaborateDec: Ast.Dec.t * {env: Env.t, nest: string list} -> Decs.t
       val reportUndeterminedTypes: unit -> unit
    end



1.7       +1 -3      mlton/mlton/elaborate/elaborate-mlbs.fun

Index: elaborate-mlbs.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-mlbs.fun,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- elaborate-mlbs.fun	24 Aug 2004 23:53:40 -0000	1.6
+++ elaborate-mlbs.fun	15 Sep 2004 18:16:27 -0000	1.7
@@ -5,6 +5,7 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
+
 functor ElaborateMLBs (S: ELABORATE_MLBS_STRUCTS): ELABORATE_MLBS = 
 struct
 
@@ -60,16 +61,13 @@
 end
 
 structure ElaboratePrograms = ElaboratePrograms (structure Ast = Ast
-						 structure ConstType = ConstType
 						 structure CoreML = CoreML
 						 structure Decs = Decs
 						 structure Env = Env)
-val lookupConstant = ElaboratePrograms.lookupConstant
 
 local
    open ElaboratePrograms
 in
-   structure ConstType = ConstType
    structure Decs = Decs
    structure Env = Env
 end



1.3       +2 -3      mlton/mlton/elaborate/elaborate-mlbs.sig

Index: elaborate-mlbs.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-mlbs.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- elaborate-mlbs.sig	4 Aug 2004 03:15:09 -0000	1.2
+++ elaborate-mlbs.sig	15 Sep 2004 18:16:27 -0000	1.3
@@ -8,7 +8,6 @@
 signature ELABORATE_MLBS_STRUCTS = 
    sig
       structure Ast: AST
-      structure ConstType: CONST_TYPE
       structure CoreML: CORE_ML
       structure Decs: DECS
       structure Env: ELABORATE_ENV
@@ -23,6 +22,6 @@
       include ELABORATE_MLBS_STRUCTS
 
       val elaborateMLB:
-	 Ast.Basdec.t * {addPrim: Env.t -> Decs.t} -> Env.t * (Decs.t * bool) vector
-      val lookupConstant: (string * ConstType.t -> CoreML.Const.t) ref
+	 Ast.Basdec.t * {addPrim: Env.t -> Decs.t}
+	 -> Env.t * (Decs.t * bool) vector
     end



1.4       +0 -2      mlton/mlton/elaborate/elaborate-modules.fun

Index: elaborate-modules.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-modules.fun,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- elaborate-modules.fun	5 Aug 2004 00:46:07 -0000	1.3
+++ elaborate-modules.fun	15 Sep 2004 18:16:27 -0000	1.4
@@ -43,11 +43,9 @@
 					     structure Env = Env)
 
 structure ElaborateCore = ElaborateCore (structure Ast = Ast
-					 structure ConstType = ConstType
 					 structure CoreML = CoreML
 					 structure Decs = Decs
 					 structure Env = Env)
-val lookupConstant = ElaborateCore.lookupConstant
 
 val elabStrdecInfo = Trace.info "elabStrdec"
 val elabTopdecInfo = Trace.info "elabTopdec"



1.3       +1 -4      mlton/mlton/elaborate/elaborate-modules.sig

Index: elaborate-modules.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-modules.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- elaborate-modules.sig	4 Aug 2004 03:15:09 -0000	1.2
+++ elaborate-modules.sig	15 Sep 2004 18:16:27 -0000	1.3
@@ -8,7 +8,6 @@
 signature ELABORATE_MODULES_STRUCTS = 
    sig
       structure Ast: AST
-      structure ConstType: CONST_TYPE
       structure CoreML: CORE_ML
       structure Decs: DECS
       structure Env: ELABORATE_ENV
@@ -22,7 +21,5 @@
    sig
       include ELABORATE_MODULES_STRUCTS
 
-      val elaborateTopdec:
-	 Ast.Topdec.t * {env: Env.t} -> Decs.t
-      val lookupConstant: (string * ConstType.t -> CoreML.Const.t) ref
+      val elaborateTopdec: Ast.Topdec.t * {env: Env.t} -> Decs.t
    end



1.3       +0 -2      mlton/mlton/elaborate/elaborate-programs.fun

Index: elaborate-programs.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-programs.fun,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- elaborate-programs.fun	4 Aug 2004 03:15:09 -0000	1.2
+++ elaborate-programs.fun	15 Sep 2004 18:16:27 -0000	1.3
@@ -11,11 +11,9 @@
 open S
 
 structure ElaborateModules = ElaborateModules (structure Ast = Ast
-					       structure ConstType = ConstType
 					       structure CoreML = CoreML
 					       structure Decs = Decs
 					       structure Env = Env)
-val lookupConstant = ElaborateModules.lookupConstant
 
 fun elaborateProgram (program, {env = E: Env.t}) =
    let



1.3       +1 -4      mlton/mlton/elaborate/elaborate-programs.sig

Index: elaborate-programs.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-programs.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- elaborate-programs.sig	4 Aug 2004 03:15:09 -0000	1.2
+++ elaborate-programs.sig	15 Sep 2004 18:16:27 -0000	1.3
@@ -8,7 +8,6 @@
 signature ELABORATE_PROGRAMS_STRUCTS = 
    sig
       structure Ast: AST
-      structure ConstType: CONST_TYPE
       structure CoreML: CORE_ML
       structure Decs: DECS
       structure Env: ELABORATE_ENV
@@ -22,7 +21,5 @@
    sig
       include ELABORATE_PROGRAMS_STRUCTS
 
-      val elaborateProgram:
-	 Ast.Program.t * {env: Env.t} -> Decs.t
-      val lookupConstant: (string * ConstType.t -> CoreML.Const.t) ref
+      val elaborateProgram: Ast.Program.t * {env: Env.t} -> Decs.t
    end



1.29      +2 -13     mlton/mlton/elaborate/elaborate.fun

Index: elaborate.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate.fun,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- elaborate.fun	4 Aug 2004 03:15:09 -0000	1.28
+++ elaborate.fun	15 Sep 2004 18:16:27 -0000	1.29
@@ -5,22 +5,12 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-functor Elaborate (S: ELABORATE_STRUCTS): ELABORATE= 
+
+functor Elaborate (S: ELABORATE_STRUCTS): ELABORATE = 
 struct
 
 open S
 
-structure ConstType =
-   struct
-      datatype t = Bool | Real | String | Word
-
-      val toString =
-	 fn Bool => "Bool"
-	  | Real => "Real"
-	  | String => "String"
-	  | Word => "Word"
-   end
-
 structure Env = ElaborateEnv (structure Ast = Ast
 			      structure CoreML = CoreML
 			      structure TypeEnv = TypeEnv)
@@ -32,7 +22,6 @@
 end
 
 structure ElaborateMLBs = ElaborateMLBs (structure Ast = Ast
-					 structure ConstType = ConstType
 					 structure CoreML = CoreML
 					 structure Decs = Decs
 					 structure Env = Env)



1.11      +2 -3      mlton/mlton/elaborate/elaborate.sig

Index: elaborate.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate.sig,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- elaborate.sig	4 Aug 2004 03:15:09 -0000	1.10
+++ elaborate.sig	15 Sep 2004 18:16:27 -0000	1.11
@@ -21,11 +21,10 @@
    sig
       include ELABORATE_STRUCTS
 
-      structure ConstType: CONST_TYPE
       structure Decs: DECS
       structure Env: ELABORATE_ENV
 
       val elaborateMLB:
-	 Ast.Basdec.t * {addPrim: Env.t -> Decs.t} -> Env.t * (Decs.t * bool) vector
-      val lookupConstant: (string * ConstType.t -> CoreML.Const.t) ref
+	 Ast.Basdec.t * {addPrim: Env.t -> Decs.t}
+	 -> Env.t * (Decs.t * bool) vector
   end



1.10      +0 -2      mlton/mlton/elaborate/sources.cm

Index: sources.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/sources.cm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- sources.cm	4 Aug 2004 03:15:09 -0000	1.9
+++ sources.cm	15 Sep 2004 18:16:27 -0000	1.10
@@ -7,7 +7,6 @@
  *)
 Group
 
-signature CONST_TYPE
 signature ELABORATE
 functor Elaborate
 functor TypeEnv
@@ -20,7 +19,6 @@
 ../core-ml/sources.cm
 ../../lib/mlton/sources.cm
 
-const-type.sig
 decs.sig
 decs.fun
 type-env.sig



1.2       +0 -1      mlton/mlton/elaborate/sources.mlb

Index: sources.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/sources.mlb,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- sources.mlb	14 Aug 2004 12:39:13 -0000	1.1
+++ sources.mlb	15 Sep 2004 18:16:27 -0000	1.2
@@ -12,7 +12,6 @@
     ../control/sources.mlb
     ../core-ml/sources.mlb
 
-    const-type.sig
     decs.sig
     decs.fun
     type-env.sig



1.37      +23 -3     mlton/mlton/front-end/ml.grm

Index: ml.grm
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/front-end/ml.grm,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- ml.grm	13 Aug 2004 23:53:35 -0000	1.36
+++ ml.grm	15 Sep 2004 18:16:28 -0000	1.37
@@ -232,7 +232,8 @@
     | RBRACKET | REC | RPAREN | SEMICOLON | SHARING | SIG | SIGNATURE | STRUCT
     | STRUCTURE | THEN | TYPE | VAL | WHERE | WHILE | WILD | WITH | WITHTYPE
       (* Extensions *)
-    | BASIS_DONE | BUILD_CONST | CONST | EXPORT | FFI | IMPORT | PRIM
+    | BASIS_DONE | BUILD_CONST | COMMAND_LINE_CONST | CONST | EXPORT | FFI
+    | IMPORT | PRIM
 
 %nonterm
          aexp of Exp.node
@@ -255,6 +256,7 @@
        | constr of Con.t * Type.t option
        | constraint of Type.t option
        | constrs of (Con.t * Type.t option) list
+       | constOrBool of Const.t
        | datBind of DatBind.t
        | datBindNoWithtype of DatBind.t
        | datatypeRhs of DatatypeRhs.t
@@ -1011,12 +1013,16 @@
 					     exp_psright)))
         | 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 {value = constOrBool},
+		     name = STRING,
+		     ty = ty})
         | 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.  Please use _import.",
+	    Layout.str "_ffi is deprecated.  Use _import.",
 	    Layout.empty)
 	   ; Exp.Prim {kind = PrimKind.Import [], name = STRING, ty = ty})
 	| EXPORT STRING attributes COLON ty SEMICOLON
@@ -1030,7 +1036,9 @@
         | PRIM STRING COLON ty SEMICOLON
 	  (Exp.Prim {kind = PrimKind.Prim, name = STRING, ty = ty})
 
-attributes :               ([])
+attributes
+   :
+     ([])
    | id attributes
      (let
 	 val id = Symbol.toString (#1 id)
@@ -1158,6 +1166,18 @@
 (*                       Atoms                       *)
 (*---------------------------------------------------*)
 
+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)))
 



1.16      +4 -2      mlton/mlton/front-end/ml.lex

Index: ml.lex
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/front-end/ml.lex,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- ml.lex	16 Feb 2004 22:42:11 -0000	1.15
+++ ml.lex	15 Sep 2004 18:16:28 -0000	1.16
@@ -129,10 +129,12 @@
 <INITIAL>{eol}	=> (Source.newline (source, yypos); continue ());
 <INITIAL>"_basis_done" =>
    (tok (Tokens.BASIS_DONE, source, yypos, yypos + size yytext));
-<INITIAL>"_const" =>
-   (tok (Tokens.CONST, source, yypos, yypos + size yytext));
 <INITIAL>"_build_const" =>
    (tok (Tokens.BUILD_CONST, source, yypos, yypos + size yytext));
+<INITIAL>"_command_line_const" =>
+   (tok (Tokens.COMMAND_LINE_CONST, source, yypos, yypos + size yytext));
+<INITIAL>"_const" =>
+   (tok (Tokens.CONST, source, yypos, yypos + size yytext));
 <INITIAL>"_export" =>
    (tok (Tokens.EXPORT, source, yypos, yypos + size yytext));
 <INITIAL>"_ffi" =>



1.46      +25 -14    mlton/mlton/main/compile.fun

Index: compile.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/compile.fun,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- compile.fun	27 Aug 2004 23:07:36 -0000	1.45
+++ compile.fun	15 Sep 2004 18:16:29 -0000	1.46
@@ -44,6 +44,7 @@
    open Atoms
 in
    structure Const = Const
+   structure ConstType = Const.ConstType
    structure Ffi = Ffi
    structure WordX = WordX
 end
@@ -89,7 +90,6 @@
 local
    open Elaborate
 in
-   structure ConstType = ConstType
    structure Env = Env
    structure Decs = Decs
 end
@@ -117,6 +117,9 @@
 (*                 Lookup Constant                   *)
 (* ------------------------------------------------- *)
 
+val commandLineConstants: {name: string, value: string} list ref = ref []
+fun setCommandLineConstant c = List.push (commandLineConstants, c)
+   
 val allConstants: (string * ConstType.t) list ref = ref []
 val amBuildingConstants: bool ref = ref false
    
@@ -127,17 +130,27 @@
 	 Promise.lazy
 	 (fn () =>
 	  if !amBuildingConstants
-	     then fn ct => (List.push (allConstants, ct)
-			    ; zero)
+	     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))
+	      LookupConstant.load (ins, !commandLineConstants)))
    in
       fn z => f () z
    end
 
-
 (* ------------------------------------------------- *)   
 (*                   Primitive Env                   *)
 (* ------------------------------------------------- *)
@@ -318,10 +331,9 @@
    {name = "parseAndElaborate",
     suffix = "core-ml",
     style = Control.ML,
-    thunk = fn () => 
-    Ref.fluidLet
-    (Elaborate.lookupConstant, lookupConstant, fn () =>
-     elaborateMLB (lexAndParseMLB input, {addPrim = addPrim})),
+    thunk = (fn () =>
+	     (Const.lookup := lookupConstant
+	      ; elaborateMLB (lexAndParseMLB input, {addPrim = addPrim}))),
     display = displayEnvDecs}
    
 (* ------------------------------------------------- *)
@@ -336,9 +348,7 @@
       val decs = Vector.map (decs, fn (decs, _) => Decs.toList decs)
       val decs = Vector.concatV (Vector.map (decs, Vector.fromList))
       (* Need to defunctorize so the constants are forced. *)
-      val _ =
-	 Defunctorize.defunctorize
-	 (CoreML.Program.T {decs = decs})
+      val _ = Defunctorize.defunctorize (CoreML.Program.T {decs = decs})
       val _ = LookupConstant.build (!allConstants, out)
    in
       ()
@@ -404,8 +414,9 @@
       (* Set GC_state offsets. *)
       val _ =
 	 let
-	    fun get (s: string): Bytes.t =
-	       case lookupConstant (s, ConstType.Word) of
+	    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



1.17      +1 -0      mlton/mlton/main/compile.sig

Index: compile.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/compile.sig,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- compile.sig	13 Aug 2004 13:50:52 -0000	1.16
+++ compile.sig	15 Sep 2004 18:16:29 -0000	1.17
@@ -30,6 +30,7 @@
 					 done: unit -> unit}} -> unit
       val elaborateMLB: {input: File.t} -> unit
       val elaborateSML: {input: File.t list} -> unit
+      val setCommandLineConstant: {name: string, value: string} -> unit
       val sourceFilesMLB: {input: File.t} -> File.t vector
       (* output a C file to print out the basis constants. *)
       val outputBasisConstants: Out.t -> unit



1.8       +40 -16    mlton/mlton/main/lookup-constant.fun

Index: lookup-constant.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/lookup-constant.fun,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- lookup-constant.fun	25 Aug 2004 17:51:10 -0000	1.7
+++ lookup-constant.fun	15 Sep 2004 18:16:29 -0000	1.8
@@ -5,6 +5,7 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
+
 functor LookupConstant (S: LOOKUP_CONSTANT_STRUCTS): LOOKUP_CONSTANT = 
 struct
 
@@ -24,13 +25,9 @@
       val int = Int.toString
       open Control
    in
-      [("Exn_keepHistory", fn () => bool (!exnHistory)),
-       ("MLton_detectOverflow", fn () => bool (!detectOverflow)),
-       ("MLton_native", fn () => bool (!codegen = Native)),
+      [("MLton_native", fn () => bool (!codegen = Native)),
        ("MLton_profile_isOn", fn () => bool (!profile <> ProfileNone)),
-       ("MLton_safe", fn () => bool (!safe)),
-       ("MLton_FFI_numExports", fn () => int (Ffi.numExports ())),
-       ("TextIO_bufSize", fn () => int (!textIOBufSize))]
+       ("MLton_FFI_numExports", fn () => int (Ffi.numExports ()))]
    end
 
 datatype z = datatype ConstType.t
@@ -117,7 +114,8 @@
        fn l => (Out.output (out, l); Out.newline out))
    end
 
-fun load (ins: In.t): string * ConstType.t -> Const.t =
+fun load (ins: In.t, commandLineConstants)
+   : {default: string option, name: string} * ConstType.t -> Const.t =
    let
       val table: {hash: word, name: string, value: string} HashSet.t =
 	 HashSet.new {hash = #hash}
@@ -132,38 +130,64 @@
 	 in
 	    ()
 	 end
-      val _ =
+      val () =
 	 List.foreach (buildConstants, fn (name, f) =>
 		       add {name = name, value = f ()})
+      val () =
+	 List.foreach
+	 (commandLineConstants, fn {name, value} =>
+	  let
+	     val () =
+		if name = "Exn.keepHistory"
+		   then (case Bool.fromString value of
+			    NONE => Error.bug "bad value for Exn.history"
+			  | SOME b => Control.exnHistory := b)
+		else ()
+	  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]))
-      fun lookupConstant (name: string, ty: ConstType.t): Const.t =
+      fun lookupConstant ({default, name}, ty: ConstType.t): Const.t =
 	 let
  	    val {value, ...} =
- 	       HashSet.lookupOrInsert
- 	       (table, String.hash name,
- 		fn {name = name', ...} => name = name',
- 		fn () => Error.bug (concat ["constant not found: ", name]))
+	       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.bug "strange Bool constant"
+		      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.bug "strange Real constant"
+		      NONE => error "real"
 		    | SOME r => Const.Real r)
 	     | String => Const.string (unescape value)
 	     | Word =>
 		  (case IntInf.fromString value of
-		      NONE => Error.bug "strange Word constant"
+		      NONE => error "int"
 		    | SOME i =>
 			 Const.Word (WordX.fromIntInf (i, WordSize.default)))
 	 end



1.3       +6 -2      mlton/mlton/main/lookup-constant.sig

Index: lookup-constant.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/lookup-constant.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- lookup-constant.sig	18 Mar 2004 03:22:25 -0000	1.2
+++ lookup-constant.sig	15 Sep 2004 18:16:29 -0000	1.3
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 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.
  *)
+
 type word = Word.t
    
 signature LOOKUP_CONSTANT_STRUCTS = 
@@ -12,6 +13,7 @@
       structure Const: CONST
       structure ConstType: CONST_TYPE
       structure Ffi: FFI
+      sharing ConstType = Const.ConstType
    end
 
 signature LOOKUP_CONSTANT = 
@@ -19,5 +21,7 @@
       include LOOKUP_CONSTANT_STRUCTS
 
       val build: (string * ConstType.t) list * Out.t -> unit
-      val load: In.t -> string * ConstType.t -> Const.t
+      val load:
+	 In.t * {name: string, value: string} list
+	 -> {default: string option, name: string} * ConstType.t -> Const.t
    end



1.63      +23 -7     mlton/mlton/main/main.fun

Index: main.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/main.fun,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -r1.62 -r1.63
--- main.fun	6 Sep 2004 05:15:49 -0000	1.62
+++ main.fun	15 Sep 2004 18:16:29 -0000	1.63
@@ -86,7 +86,7 @@
 
 fun setTargetType (target: string, usage): unit =
    case List.peek (targetMap (), fn {target = t, ...} => t = target) of
-      NONE => usage (concat ["invalid target ", target])
+      NONE => usage (concat ["invalid target: ", target])
     | SOME {arch, os, ...} =>
 	 let
 	    datatype z = datatype MLton.Platform.Arch.t
@@ -103,7 +103,11 @@
    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 makeOptions {usage} = 
    let
       val usage = fn s => (usage s; raise Fail "unreachable")
@@ -169,6 +173,13 @@
 		      | "c" => codegen := CCodegen
 		      | "native" => codegen := 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]))),
        (Expert, "contify-into-main", " {false|true}",
 	"contify functions into main",
 	boolRef contifyIntoMain),
@@ -190,7 +201,9 @@
 	     else usage (concat ["invalid -default-ann flag: ", s])))),
        (Expert, "detect-overflow", " {true|false}",
 	"overflow checking on integer arithmetic",
-	boolRef detectOverflow),
+	Bool (fn b => setConst ("detect-overflow",
+				"MLton.detectOverflow",
+				Bool.toString b))),
        (Expert, "diag-pass", " <pass>", "keep diagnostic info for pass",
 	SpaceString 
 	(fn s =>
@@ -231,8 +244,9 @@
 	     else usage (concat ["invalid -enable-ann flag: ", s])))),
        (Expert, "error-threshhold", " 20", "error threshhold",
 	intRef errorThreshhold),
-       (Normal, "exn-history", " {false|true}", "enable Exn.history",
-	boolRef exnHistory),
+       (Expert, "exn-history", " {false|true}", "enable Exn.history",
+	Bool (fn b => setConst ("exn-history", "Exn.keepHistory",
+				Bool.toString b))),
        (Expert, "expert", " {false|true}", "enable expert status",
 	boolRef expert),
        (Normal, "export-header", " <file>", "write C header file for _export's",
@@ -392,7 +406,7 @@
        (Normal, "runtime", " <arg>", "pass arg to runtime via @MLton",
 	push runtimeArgs),
        (Expert, "safe", " {true|false}", "bounds checking and other checks",
-	boolRef safe),
+	Bool (fn b => setConst ("safe", "MLton.safe", Bool.toString b))),
        (Expert, "sequence-unit", " {false|true}",
 	"in (e1; e2), require e1: unit",
 	Bool (fn b =>
@@ -448,7 +462,9 @@
 	  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",
-	intRef textIOBufSize),
+	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",