[MLton-commit] r5164
Matthew Fluet
fluet at mlton.org
Sat Feb 10 18:21:00 PST 2007
Eliminate more unused values
----------------------------------------------------------------------
U mlton/trunk/include/x86-main.h
U mlton/trunk/mlton/ast/ast-atoms.fun
U mlton/trunk/mlton/ast/ast-atoms.sig
U mlton/trunk/mlton/ast/ast-const.fun
U mlton/trunk/mlton/ast/ast-const.sig
U mlton/trunk/mlton/ast/ast-core.fun
U mlton/trunk/mlton/ast/ast-core.sig
U mlton/trunk/mlton/ast/ast-id.fun
U mlton/trunk/mlton/ast/ast-id.sig
U mlton/trunk/mlton/ast/ast-mlbs.fun
U mlton/trunk/mlton/ast/ast-mlbs.sig
U mlton/trunk/mlton/ast/ast-modules.fun
U mlton/trunk/mlton/ast/ast-modules.sig
U mlton/trunk/mlton/ast/ast-programs.fun
U mlton/trunk/mlton/ast/ast-programs.sig
U mlton/trunk/mlton/ast/longid.fun
U mlton/trunk/mlton/ast/longid.sig
U mlton/trunk/mlton/ast/prim-tycons.fun
U mlton/trunk/mlton/ast/prim-tycons.sig
U mlton/trunk/mlton/ast/tyvar.fun
U mlton/trunk/mlton/atoms/c-function.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-liveness.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-liveness.sig
U mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.sig
U mlton/trunk/mlton/codegen/x86-codegen/x86-pseudo.sig
U mlton/trunk/mlton/codegen/x86-codegen/x86-simplify.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86.sig
U mlton/trunk/mlton/elaborate/elaborate-env.fun
U mlton/trunk/mlton/elaborate/elaborate-env.sig
U mlton/trunk/mlton/elaborate/type-env.fun
U mlton/trunk/mlton/elaborate/type-env.sig
U mlton/trunk/mlton/match-compile/match-compile.sig
U mlton/trunk/mlton/ssa/ssa-tree2.fun
U mlton/trunk/mlton/xml/xml-tree.fun
U mlton/trunk/mlton/xml/xml-tree.sig
----------------------------------------------------------------------
Modified: mlton/trunk/include/x86-main.h
===================================================================
--- mlton/trunk/include/x86-main.h 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/include/x86-main.h 2007-02-11 02:20:54 UTC (rev 5164)
@@ -16,16 +16,10 @@
Word32 checkTemp;
Word32 cReturnTemp[16];
Pointer c_stackP;
-Word32 c_stackPTrue;
Word32 divTemp;
-Word32 eq1Temp;
-Word32 eq2Temp;
-Word32 fileTemp;
Word32 fildTemp;
Word32 fpswTemp;
Word32 indexTemp;
-Word32 intInfTemp;
-char MLton_bug_msg[] = "cps machine";
Word32 raTemp1;
Real64 raTemp2;
Real64 realTemp1D;
@@ -36,15 +30,9 @@
Real32 realTemp3S;
Word32 spill[16];
Word32 stackTopTemp;
-Word32 statusTemp;
-Word32 switchTemp;
-Word32 threadTemp;
Word8 wordTemp1B;
-Word8 wordTemp2B;
Word16 wordTemp1W;
-Word16 wordTemp2W;
Word32 wordTemp1L;
-Word32 wordTemp2L;
#ifndef DEBUG_X86CODEGEN
#define DEBUG_X86CODEGEN FALSE
Modified: mlton/trunk/mlton/ast/ast-atoms.fun
===================================================================
--- mlton/trunk/mlton/ast/ast-atoms.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-atoms.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -92,8 +92,6 @@
in
val toCon = make Con.fromSymbol
val toVar = make Var.fromSymbol
- val toFctid = make Fctid.fromSymbol
- val toStrid = make Strid.fromSymbol
end
end
@@ -133,22 +131,13 @@
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
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
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)
end
end
@@ -198,7 +187,7 @@
open Wrap
datatype node =
Con of Longtycon.t * t vector
- | Record of node Wrap.t Record.t (* kit barfs on t Record.t *)
+ | Record of t Record.t
| Var of Tyvar.t
withtype t = node Wrap.t
type node' = node
Modified: mlton/trunk/mlton/ast/ast-atoms.sig
===================================================================
--- mlton/trunk/mlton/ast/ast-atoms.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-atoms.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -56,7 +56,6 @@
val fromCon: Con.t -> t
val toVar: t -> Var.t
val toCon: t -> Con.t
- val toFctid: t -> Fctid.t
end
structure Longtycon:
@@ -72,10 +71,7 @@
sig
include LONGID
- 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
Modified: mlton/trunk/mlton/ast/ast-const.fun
===================================================================
--- mlton/trunk/mlton/ast/ast-const.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-const.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -56,6 +56,4 @@
| Word w => str (concat ["0wx", IntInf.format (w, StringCvt.HEX)])
end
-val toString = Layout.toString o layout
-
end
Modified: mlton/trunk/mlton/ast/ast-const.sig
===================================================================
--- mlton/trunk/mlton/ast/ast-const.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-const.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -27,5 +27,4 @@
val layout: t -> Layout.t
val ordToString: IntInf.t -> string
- val toString: t -> string
end
Modified: mlton/trunk/mlton/ast/ast-core.fun
===================================================================
--- mlton/trunk/mlton/ast/ast-core.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-core.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -96,7 +96,6 @@
fun make n = makeRegion (n, Region.bogus)
val wild = make Wild
- val const = make o Const
val constraint = make o Constraint
val layered = make o Layered
@@ -232,11 +231,6 @@
structure SymbolAttribute =
struct
datatype t = Alloc
-
- val toString: t -> string =
- fn Alloc => "alloc"
-
- val layout = Layout.str o toString
end
datatype t =
@@ -579,13 +573,6 @@
(checkSyntaxExp exp
; Pat.checkSyntax pat)))
-structure Match =
- struct
- open Match
-
- val layout = layoutMatch
- end
-
structure Exp =
struct
open Wrap
Modified: mlton/trunk/mlton/ast/ast-core.sig
===================================================================
--- mlton/trunk/mlton/ast/ast-core.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-core.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -65,7 +65,6 @@
include WRAPPED sharing type node' = node
sharing type obj = t
- val const: Const.t -> t
val constraint: t * Type.t -> t
val layered: {fixop: Fixop.t,
var: Var.t,
@@ -91,8 +90,6 @@
structure SymbolAttribute:
sig
datatype t = Alloc
-
- val layout: t -> Layout.t
end
datatype t =
@@ -179,8 +176,6 @@
include WRAPPED
sharing type node' = node
sharing type obj = t
-
- val layout: t -> Layout.t
end where type t = Exp.match
structure EbRhs:
Modified: mlton/trunk/mlton/ast/ast-id.fun
===================================================================
--- mlton/trunk/mlton/ast/ast-id.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-id.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -25,6 +25,8 @@
end
val node = name
+(* quell unused warning *)
+val _ = node
val toSymbol = name
fun makeRegion (s, r) = T {name = s,
@@ -34,8 +36,12 @@
fun makeRegion' (s, x, y) =
makeRegion (s, Region.make {left = x, right = y})
+(* quell unused warning *)
+val _ = makeRegion'
fun dest (T {name, region, ...}) = (name, region)
+(* quell unused warning *)
+val _ = dest
val bogus = makeRegion (Symbol.bogus, Region.bogus)
@@ -52,9 +58,6 @@
val layout = String.layout o toString
-val hash = Symbol.hash o name
-val hash = Trace.trace ("AstId.hash", layout, Word.layout) hash
-
(* val left = Region.left o region *)
(* val right = Region.left o region *)
@@ -62,10 +65,6 @@
fun binary (f: string * string -> 'a) (x :t, y: t): 'a =
f (toString x, toString y)
in
- val op < = binary String.<
- val op > = binary String.>
- val op >= = binary String.>=
- val op <= = binary String.<=
val compare = binary String.compare
end
Modified: mlton/trunk/mlton/ast/ast-id.sig
===================================================================
--- mlton/trunk/mlton/ast/ast-id.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-id.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -19,15 +19,10 @@
type t
sharing type obj = t
- val < : t * t -> bool
- val <= : t * t -> bool
- val > : t * t -> bool
- val >= : t * t -> bool
val bogus: t
val compare: t * t -> Relation.t
val equals: t * t -> bool
val fromSymbol: Symbol.t * Region.t -> t
- val hash: t -> Word.t
val isSymbolic: t -> bool
val layout: t -> Layout.t
val toString: t -> string
Modified: mlton/trunk/mlton/ast/ast-mlbs.fun
===================================================================
--- mlton/trunk/mlton/ast/ast-mlbs.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-mlbs.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -155,11 +155,6 @@
type node' = node
type obj = t
- fun make n = makeRegion (n, Region.bogus)
- val bas = make o Bas
- val lett = make o Let
- val var = make o Var
- val checkSyntax = checkSyntaxBasexp
val layout = layoutBasexp
end
@@ -172,16 +167,8 @@
type obj = t
fun make n = makeRegion (n, Region.bogus)
- val ann = make o Ann
- val defs = make o Defs
- val basis = make o Basis
- val locall = make o Local
val seq = make o Seq
val empty = seq []
- val mlb = make o MLB
- val openn = make o Open
- val prim = make Prim
- val prog = make o Prog
val checkSyntax = checkSyntaxBasdec
val layout = layoutBasdec
val sourceFiles = sourceFiles
Modified: mlton/trunk/mlton/ast/ast-mlbs.sig
===================================================================
--- mlton/trunk/mlton/ast/ast-mlbs.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-mlbs.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -28,11 +28,6 @@
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 checkSyntax: t -> unit
val layout: t -> Layout.t
end
@@ -53,15 +48,7 @@
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 checkSyntax: t -> unit
Modified: mlton/trunk/mlton/ast/ast-modules.fun
===================================================================
--- mlton/trunk/mlton/ast/ast-modules.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-modules.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -233,7 +233,6 @@
fun make n = makeRegion (n, Region.bogus)
val spec = make o Spec
- val var = make o Var
val layout = layoutSigexp
end
@@ -342,10 +341,7 @@
val checkSyntax = checkSyntaxStrexp
fun make n = makeRegion (n, Region.bogus)
- val var = make o Var
- val structt = make o Struct
val constrained = make o Constrained
- val app = make o App
val lett = make o Let
val layout = layoutStrexp
end
@@ -360,11 +356,8 @@
val checkSyntax = checkSyntaxStrdec
fun make n = makeRegion (n, Region.bogus)
- val structuree = make o Structure
- val locall = make o Local
val core = make o Core
- val seq = make o Seq
val openn = core o Dec.openn
@@ -490,9 +483,6 @@
fun make n = makeRegion (n, Region.bogus)
val fromExp = make o Strdec o Strdec.fromExp
- val functorr = make o Functor
- val signaturee = make o Signature
- val strdec = make o Strdec
fun checkSyntax (d: t): unit =
case node d of
Modified: mlton/trunk/mlton/ast/ast-modules.sig
===================================================================
--- mlton/trunk/mlton/ast/ast-modules.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-modules.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -30,7 +30,6 @@
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
@@ -99,10 +98,7 @@
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
@@ -125,12 +121,7 @@
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 structuree: {name: Strid.t,
- def: Strexp.t,
- constraint: SigConst.t} vector -> t
end
sharing type Strdec.t = Strexp.strdec
@@ -160,12 +151,6 @@
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 strdec: Strdec.t -> t
end
end
Modified: mlton/trunk/mlton/ast/ast-programs.fun
===================================================================
--- mlton/trunk/mlton/ast/ast-programs.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-programs.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -21,8 +21,6 @@
val empty = T []
- fun append (T ds1, T ds2) = T (ds1 @ ds2)
-
fun layout (T dss) =
Layout.align (List.map (dss, fn ds =>
Layout.paren
@@ -148,6 +146,8 @@
in
!n
end
+ (* quell unused warning *)
+ val _ = size
end
end
Modified: mlton/trunk/mlton/ast/ast-programs.sig
===================================================================
--- mlton/trunk/mlton/ast/ast-programs.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/ast-programs.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -19,7 +19,6 @@
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
Modified: mlton/trunk/mlton/ast/longid.fun
===================================================================
--- mlton/trunk/mlton/ast/longid.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/longid.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -27,36 +27,6 @@
(strids, id)
end
-fun prepend (id, strid) =
- let
- val (T {strids, id}, region) = dest id
- in
- makeRegion (T {strids = strid :: strids, id = id},
- region)
- end
-
-fun prepends (id, strids') =
- let
- val (T {strids, id}, region) = dest id
- in
- makeRegion (T {strids = strids' @ strids, id = id},
- region)
- end
-
-fun isLong id =
- let
- val T {strids, ...} = node id
- in
- not (List.isEmpty strids)
- end
-
-fun toId id =
- let
- val T {id, ...} = node id
- in
- id
- end
-
val equals =
fn (id, id') =>
let
@@ -123,6 +93,4 @@
region)
end
-val bogus = short Id.bogus
-
end
Modified: mlton/trunk/mlton/ast/longid.sig
===================================================================
--- mlton/trunk/mlton/ast/longid.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/longid.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -25,18 +25,9 @@
include WRAPPED sharing type node' = node
sharing type obj = t
- val bogus: t
val fromSymbols: Symbol.t list * Region.t -> t
- val isLong: t -> bool (* returns true if the list of strids is nonempty *)
val long: Strid.t list * Id.t -> t
- (* prepend with a path:
- * prepend (([B, C], x), A) = ([A, B, C], x)
- * prepends (([C, D], x), [A, B]) = ([A, B, C, D], x)
- *)
- val prepend: t * Strid.t -> t
- val prepends: t * Strid.t list -> t
val short: Id.t -> t
val split: t -> Strid.t list * Id.t
- val toId: t -> Id.t
val toString: t -> string
end
Modified: mlton/trunk/mlton/ast/prim-tycons.fun
===================================================================
--- mlton/trunk/mlton/ast/prim-tycons.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/prim-tycons.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -18,8 +18,6 @@
| Tuple
| Unit
- val arrow = Arrow
- val tuple = Tuple
val unit = Unit
end
@@ -171,7 +169,6 @@
| _ => Error.bug "PrimTycons.defaultWord"
val isBool = fn c => equals (c, bool)
-val isExn = fn c => equals (c, exn)
val isPointer = fn c => equals (c, pointer)
val isIntX = fn c => equals (c, intInf) orelse isIntX c
val deIntX = fn c => if equals (c, intInf) then NONE else SOME (deIntX c)
Modified: mlton/trunk/mlton/ast/prim-tycons.sig
===================================================================
--- mlton/trunk/mlton/ast/prim-tycons.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/prim-tycons.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -31,8 +31,6 @@
sig
type t
- val arrow: t
- val tuple: t
val unit: t
end
@@ -62,7 +60,6 @@
val intInf: tycon
val isBool: tycon -> bool
val isCharX: tycon -> bool
- val isExn: tycon -> bool
val isIntX: tycon -> bool
val isPointer: tycon -> bool
val isRealX: tycon -> bool
Modified: mlton/trunk/mlton/ast/tyvar.fun
===================================================================
--- mlton/trunk/mlton/ast/tyvar.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ast/tyvar.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -67,7 +67,10 @@
*)
local val c = Counter.new 0
-in fun reset () = Counter.reset (c, 0)
+in
+ fun reset () = Counter.reset (c, 0)
+ (* quell unused warning *)
+ val _ = reset
fun newNoname {equality} =
new {name = "a_" ^ Int.toString (Counter.next c),
equality = equality}
Modified: mlton/trunk/mlton/atoms/c-function.fun
===================================================================
--- mlton/trunk/mlton/atoms/c-function.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/atoms/c-function.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -92,6 +92,8 @@
fun target z = make #target z
fun writesStackTop z = make #writesStackTop z
end
+(* quell unused warnings *)
+val _ = (modifiesFrontier, readsStackTop, writesStackTop)
fun equals (f, f') = Target.equals (target f, target f')
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-liveness.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-liveness.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-liveness.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -463,32 +463,6 @@
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]
-
fun printBlock (T {entry, statements, transfer, ...})
= (let
val (entry,info) = entry
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-liveness.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-liveness.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-liveness.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -62,7 +62,6 @@
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} ->
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -148,14 +148,6 @@
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}
- val c_stackPDerefOperand
- = Operand.memloc c_stackPDeref
val c_stackPDerefDouble
= MemLoc.simple {base = c_stackPContents,
index = Immediate.const_int 0,
@@ -173,30 +165,6 @@
val c_stackPDerefFloatOperand
= Operand.memloc c_stackPDerefFloat
- val threadTemp = Label.fromString "threadTemp"
- val threadTempContents
- = makeContents {base = Immediate.label threadTemp,
- 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}
- val statusTempContentsOperand
- = Operand.memloc statusTempContents
-
- val fileTemp = Label.fromString "fileTemp"
- val fileTempContents
- = makeContents {base = Immediate.label fileTemp,
- size = pointerSize,
- class = Classes.StaticTemp}
- val fileTempContentsOperand
- = Operand.memloc fileTempContents
-
val applyFFTemp = Label.fromString "applyFFTemp"
val applyFFTempContents
= makeContents {base = Immediate.label applyFFTemp,
@@ -287,21 +255,6 @@
val fildTempContentsOperand
= Operand.memloc fildTempContents
- val eq1Temp = Label.fromString "eq1Temp"
- val eq1TempContents
- = makeContents {base = Immediate.label eq1Temp,
- 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}
- val eq2TempContentsOperand
- = Operand.memloc eq2TempContents
-
val wordTemp1B = Label.fromString "wordTemp1B"
val wordTemp1ContentsB
= makeContents {base = Immediate.label wordTemp1B,
@@ -330,35 +283,6 @@
| Size.LONG => wordTemp1ContentsOperandL
| _ => Error.bug "x86MLtonBasic.wordTemp1ContentsOperand: wordSize"
- val wordTemp2B = Label.fromString "wordTemp2B"
- val wordTemp2ContentsB
- = makeContents {base = Immediate.label wordTemp2B,
- 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}
- val wordTemp2ContentsOperandW
- = Operand.memloc wordTemp2ContentsW
- val wordTemp2L = Label.fromString "wordTemp2L"
- val wordTemp2ContentsL
- = makeContents {base = Immediate.label wordTemp2L,
- size = Size.LONG,
- class = Classes.StaticTemp}
- val wordTemp2ContentsOperandL
- = Operand.memloc wordTemp2ContentsL
- fun wordTemp2ContentsOperand wordSize
- = case wordSize of
- Size.BYTE => wordTemp2ContentsOperandB
- | Size.WORD => wordTemp2ContentsOperandW
- | Size.LONG => wordTemp2ContentsOperandL
- | _ => Error.bug "x86MLtonBasic.wordTemp2ContentsOperand: wordSize"
-
-
local
fun make prefix =
let
@@ -478,22 +402,6 @@
val stackTopTempContentsOperand = fn () => stackTopTempContentsOperand
end
- local
- fun make (contents, 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)
- val gcState_stackTopDerefOperand =
- make (gcState_stackTopContents, Classes.Stack)
- val stackTopTempDerefOperand =
- make (stackTopTempContents, Classes.Stack)
- end
-
fun gcState_stackTopMinusWordDeref () =
MemLoc.simple {base = gcState_stackTopContents (),
index = Immediate.const_int ~1,
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -77,25 +77,18 @@
val c_stackP : x86.Label.t
val c_stackPContents : x86.MemLoc.t
val c_stackPContentsOperand : x86.Operand.t
- val c_stackPDerefOperand : x86.Operand.t
val c_stackPDerefDoubleOperand : x86.Operand.t
val c_stackPDerefFloatOperand : x86.Operand.t
(* Static temps defined in x86-main.h *)
val applyFFTempContentsOperand : x86.Operand.t
val applyFFTemp2ContentsOperand : x86.Operand.t
- val threadTempContentsOperand : x86.Operand.t
- val fileTempContentsOperand : x86.Operand.t
val realTemp1ContentsOperand : x86.Size.t -> x86.Operand.t
val realTemp2ContentsOperand : x86.Size.t -> x86.Operand.t
val realTemp3ContentsOperand : x86.Size.t -> x86.Operand.t
val fildTempContentsOperand : x86.Operand.t
val fpswTempContentsOperand : x86.Operand.t
- val statusTempContentsOperand : x86.Operand.t
- val eq1TempContentsOperand : x86.Operand.t
- val eq2TempContentsOperand : x86.Operand.t
val wordTemp1ContentsOperand : x86.Size.t -> x86.Operand.t
- val wordTemp2ContentsOperand : x86.Size.t -> x86.Operand.t
(* Static arrays defined in main.h and x86-main.h *)
val local_base : x86.CType.t -> x86.Label.t
@@ -114,17 +107,14 @@
val gcState_exnStackContentsOperand: unit -> x86.Operand.t
val gcState_frontierContents: unit -> x86.MemLoc.t
val gcState_frontierContentsOperand: unit -> x86.Operand.t
- val gcState_frontierDerefOperand: unit -> x86.Operand.t
val gcState_stackBottomContents: unit -> x86.MemLoc.t
val gcState_stackBottomContentsOperand: unit -> x86.Operand.t
val gcState_stackTopContents: unit -> x86.MemLoc.t
val gcState_stackTopContentsOperand: unit -> x86.Operand.t
- val gcState_stackTopDerefOperand: unit -> x86.Operand.t
val gcState_stackTopMinusWordDeref: unit -> x86.MemLoc.t
val gcState_stackTopMinusWordDerefOperand: unit -> x86.Operand.t
val stackTopTempContentsOperand: unit -> x86.Operand.t
- val stackTopTempDerefOperand: unit -> x86.Operand.t
val stackTopTempMinusWordDeref: unit -> x86.MemLoc.t
val stackTopTempMinusWordDerefOperand: unit -> x86.Operand.t
end
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-pseudo.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-pseudo.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-pseudo.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -66,10 +66,7 @@
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
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-simplify.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-simplify.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-simplify.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -2951,28 +2951,6 @@
| _ => 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 {statements, live}
= LivenessBlock.reLivenessStatements
{statements = List.rev start,
@@ -4159,16 +4137,6 @@
jumpInfo : x86JumpInfo.t} :
Chunk.t
= let
- 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 changedChunk_msg
{chunk as Chunk.T {blocks, ...}, changed, msg}
@@ -4181,10 +4149,10 @@
= if changed then (print ("finished " ^ msg ^ "\n")) else ()
*)
-(*
fun changedChunk_msg
- {chunk as Chunk.T {blocks, ...}, changed, msg}
- = (print (String.make (60, #"*"));
+ {chunk = Chunk.T {blocks, ...}, changed, msg}
+ = if not changed then () else
+ (print (String.make (60, #"*"));
print "\n";
print msg;
print "\n";
@@ -4204,7 +4172,8 @@
fun changedBlock_msg
{block as Block.T {entry, ...}, changed, msg}
- = (print (String.make (60, #"*"));
+ = if not changed then () else
+ (print (String.make (60, #"*"));
print "\n";
print msg;
print "\n";
@@ -4222,7 +4191,8 @@
fun changedLivenessBlock_msg
{block as x86Liveness.LivenessBlock.T {entry, ...}, changed, msg}
- = (print (String.make (60, #"*"));
+ = if not changed then () else
+ (print (String.make (60, #"*"));
print "\n";
print msg;
print "\n";
@@ -4237,8 +4207,15 @@
"\n "),
"\n"]);
x86Liveness.LivenessBlock.printBlock block))
-*)
+ val debug = false
+ val changedChunk_msg : {chunk : Chunk.t, changed: bool, msg: string} -> unit =
+ if debug then changedChunk_msg else (fn _ => ())
+ val changedBlock_msg : {block : Block.t, changed: bool, msg: string} -> unit =
+ if debug then changedBlock_msg else (fn _ => ())
+ val changedLivenessBlock_msg : {block : x86Liveness.LivenessBlock.t, changed: bool, msg: string} -> unit =
+ if debug then changedLivenessBlock_msg else (fn _ => ())
+
fun checkLivenessBlock
{block, block', msg}
= Assert.assert
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -59,15 +59,6 @@
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
- val class_toString = Layout.toString o class_layout
datatype t
= BYTE | WORD | LONG
@@ -105,6 +96,8 @@
| FPIQ => str "fpiq"
end
val toString' = Layout.toString o layout'
+ (* quell unused warning *)
+ val _ = toString'
val fromBytes : int -> t
= fn 1 => BYTE
@@ -279,6 +272,8 @@
end)
fun coincident (T {reg, ...}) = coincident' reg
+ (* quell unused warning *)
+ val _ = coincident
val registers
= fn Size.BYTE => byteRegisters
@@ -348,6 +343,8 @@
| (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"
+ (* quell unused warning *)
+ val _ = fullPartOf
end
structure FltRegister =
@@ -627,14 +624,10 @@
val const_char = const o Char
val const_int = const o Int
val const_word = const o Word
- val deConst
- = fn T {immediate = Const c, ...} => SOME c
- | _ => NONE
val label = construct o Label
val deLabel
= fn T {immediate = Label l, ...} => SOME l
| _ => NONE
- val unexp = construct o ImmedUnExp
val binexp = construct o ImmedBinExp
end
@@ -735,6 +728,8 @@
exp2 = i})
| NONE => SOME i,
base = base, index = index, scale = scale}
+ (* quell unused warning *)
+ val _ = shift
end
structure MemLoc =
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -39,7 +39,6 @@
structure Size :
sig
datatype class = INT | FLT | FPI
- val class_toString : class -> string
datatype t
= BYTE | WORD | LONG
@@ -156,11 +155,8 @@
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
Modified: mlton/trunk/mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-env.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/elaborate/elaborate-env.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -1953,7 +1953,6 @@
end
val peekLongcon = PeekResult.toOption o peekLongcon
-val peekLongtycon = PeekResult.toOption o peekLongtycon
(* ------------------------------------------------- *)
(* extend *)
Modified: mlton/trunk/mlton/elaborate/elaborate-env.sig
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-env.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/elaborate/elaborate-env.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -212,7 +212,6 @@
val peekFix: t * Ast.Vid.t -> Ast.Fixity.t option
val peekLongcon:
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
* during f () are forgotten afterwards.
Modified: mlton/trunk/mlton/elaborate/type-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/type-env.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/elaborate/type-env.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -506,8 +506,6 @@
end
end
- val toString = Layout.toString o layout
-
fun admitsEquality t =
case Equality.toBoolOpt (equality t) of
NONE =>
Modified: mlton/trunk/mlton/elaborate/type-env.sig
===================================================================
--- mlton/trunk/mlton/elaborate/type-env.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/elaborate/type-env.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -60,7 +60,6 @@
val minTime: t * Time.t -> unit
val new: unit -> t
val record: t SortedRecord.t -> t
- val toString: t -> string
(* make two types identical (recursively). side-effecting. *)
val unify:
t * t * {error: Layout.t * Layout.t -> unit,
Modified: mlton/trunk/mlton/match-compile/match-compile.sig
===================================================================
--- mlton/trunk/mlton/match-compile/match-compile.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/match-compile/match-compile.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -48,7 +48,6 @@
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
Modified: mlton/trunk/mlton/ssa/ssa-tree2.fun
===================================================================
--- mlton/trunk/mlton/ssa/ssa-tree2.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/ssa/ssa-tree2.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -729,6 +729,8 @@
Base.equals (b1, b2, Var.equals) andalso i1 = i2
| (Var x, Var x') => Var.equals (x, x')
| _ => false
+ (* quell unused warning *)
+ val _ = equals
local
val newHash = Random.word
@@ -755,6 +757,8 @@
Base.hash (base, Var.hash) + Word.fromInt offset)
| Var x => Var.hash x
end
+ (* quell unused warning *)
+ val _ = hash
end
datatype z = datatype Exp.t
@@ -999,6 +1003,8 @@
| Handler.Dead => handler
| Handler.Handle _ => handler)}
| Tail => r
+ (* quell unused warning *)
+ val _ = compose
local
val newHash = Random.word
@@ -1067,6 +1073,8 @@
fun foreachFunc (t, func) =
foreachFuncLabelVar (t, func, fn _ => (), fn _ => ())
+ (* quell unused warning *)
+ val _ = foreachFunc
fun foreachLabelVar (t, label, var) =
foreachFuncLabelVar (t, fn _ => (), label, var)
@@ -1106,6 +1114,8 @@
end
fun replaceLabel (t, f) = replaceLabelVar (t, f, fn x => x)
+ (* quell unused warning *)
+ val _ = replaceLabel
fun replaceVar (t, f) = replaceLabelVar (t, fn l => l, f)
local open Layout
@@ -1188,6 +1198,8 @@
varsEquals (args, args') andalso
Label.equals (return, return')
| _ => false
+ (* quell unused warning *)
+ val _ = equals
local
val newHash = Random.word
@@ -1221,6 +1233,8 @@
| Return xs => hashVars (xs, return)
| Runtime {args, return, ...} => hashVars (args, Label.hash return)
end
+ (* quell unused warning *)
+ val _ = hash
end
datatype z = datatype Transfer.t
@@ -1767,6 +1781,8 @@
returns = returns,
start = start}
end
+ (* quell unused warning *)
+ val _ = alphaRename
fun profile (f: t, sourceInfo): t =
if !Control.profile = Control.ProfileNone
Modified: mlton/trunk/mlton/xml/xml-tree.fun
===================================================================
--- mlton/trunk/mlton/xml/xml-tree.fun 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/xml/xml-tree.fun 2007-02-11 02:20:54 UTC (rev 5164)
@@ -132,7 +132,6 @@
local
fun make f (T r) = f r
in
- val targs = make #targs
val var = make #var
end
@@ -464,6 +463,8 @@
handleExp = f,
handleBoundVar = ignore,
handleVarExp = ignore}
+ (* quell unused warning *)
+ val _ = foreachExp
fun hasPrim (e, f) =
Exn.withEscape
@@ -481,10 +482,9 @@
in foreachPrimExp (e, fn _ => inc ());
!n
end
-
-(*
val size = Trace.trace ("XmlTree.Exp.size", Layout.ignore, Int.layout) size
-*)
+ (* quell unused warning *)
+ val _ = size
fun clear (e: t): unit =
let open PrimExp
@@ -538,7 +538,6 @@
fun make f (Lam r) = f r
in
val arg = make #arg
- val argType = make #argType
val body = make #body
val mayInline = make #mayInline
end
@@ -592,8 +591,6 @@
fun toExp e = send (e, Cont.id)
- val layout = Exp.layout o toExp
-
fun fromExp (Exp {decs, result}, ty): t =
fn k => Exp.prefixs (k (Var result, ty), decs)
@@ -824,16 +821,6 @@
end)
end
-structure Exp =
- struct
- open Exp
-
- fun unit () =
- let open DirectExp
- in toExp (tuple {exps = Vector.new0 (), ty = Type.unit})
- end
- end
-
(*---------------------------------------------------*)
(* Datatype *)
(*---------------------------------------------------*)
@@ -884,10 +871,6 @@
; Vector.foreach (cons, Con.clear o #con)))
; Exp.clear body)
- val empty = T {datatypes = Vector.new0 (),
- body = Exp.unit (),
- overflow = NONE}
-
fun layoutStats (T {datatypes, body, ...}) =
let
val numTypes = ref 0
Modified: mlton/trunk/mlton/xml/xml-tree.sig
===================================================================
--- mlton/trunk/mlton/xml/xml-tree.sig 2007-02-10 21:39:44 UTC (rev 5163)
+++ mlton/trunk/mlton/xml/xml-tree.sig 2007-02-11 02:20:54 UTC (rev 5164)
@@ -59,7 +59,6 @@
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,
@@ -83,7 +82,6 @@
val layout: t -> Layout.t
val mono: Var.t -> t
- val targs: t -> Type.t vector
val var: t -> Var.t
end
@@ -210,7 +208,6 @@
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
More information about the MLton-commit
mailing list