From 5d369913766dd59d6e3968dfe559ba60f2c650b8 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Sat, 18 Aug 2018 14:40:22 -0400 Subject: [PATCH] Revert unnecessary white-space changes --- lib/mlton/basic/parse.sig | 5 +- lib/mlton/basic/parse.sml | 4 +- mlton/main/compile.fun | 26 +++---- mlton/main/compile.sig | 1 - mlton/main/main.fun | 1 - mlton/ssa/parse-ssa.fun | 58 +++++++------- mlton/ssa/ssa-tree.fun | 70 ++++++++--------- mlton/ssa/ssa-tree.sig | 4 +- mlton/ssa/ssa-tree2.fun | 157 +++++++++++++++++++------------------- mlton/ssa/ssa-tree2.sig | 8 +- mlton/xml/parse-sxml.fun | 2 +- 11 files changed, 165 insertions(+), 171 deletions(-) diff --git a/lib/mlton/basic/parse.sig b/lib/mlton/basic/parse.sig index fcdb56a76e..68040f1495 100644 --- a/lib/mlton/basic/parse.sig +++ b/lib/mlton/basic/parse.sig @@ -23,7 +23,7 @@ signature PARSE = (* * infix 1 <|> >>= * infix 3 <*> <* *> - * infixr 4 <$> <$$> <$$$> <$$$$> <$ <$?> + * infixr 4 <$> <$$> <$$$> <$$$$> <$ <$?> *) val >>= : 'a t * ('a -> 'b t) -> 'b t val <*> : ('a -> 'b) t * 'a t -> 'b t @@ -96,9 +96,6 @@ signature PARSE = val notFollowedBy: 'a t * 'b t -> 'a t (* succeeds with SOME if the parser succeeded and NONE otherwise *) val optional: 'a t -> 'a option t - - (*val optionalWN: 'a t -> 'a t*) - (* parse an integer, as Integer.scan StringCVT.DEC *) val int: int t val intInf: IntInf.t t diff --git a/lib/mlton/basic/parse.sml b/lib/mlton/basic/parse.sml index 000cd9fb3c..22c7939614 100644 --- a/lib/mlton/basic/parse.sml +++ b/lib/mlton/basic/parse.sml @@ -9,7 +9,7 @@ struct infix 1 <|> >>= infix 3 <*> <* *> -infixr 4 <$> <$$> <$$$> <$$$$> <$ <$?> +infixr 4 <$> <$$> <$$$> <$$$$> <$ <$?> structure Location = struct @@ -215,8 +215,6 @@ fun sepBy(t, sep) = uncut ((op ::) <$$> (t, many' (sep *> t)) <|> pure []) fun optional t = SOME <$> t <|> pure NONE -(*fun optionalWN t = SOME <$> t <|> NONE <$> t*) - fun char c s = case Stream.force (s) of NONE => Failure [String.fromChar c ^ " at end of file"] | SOME((h, _), r) => diff --git a/mlton/main/compile.fun b/mlton/main/compile.fun index da8ed011c6..ff91c00372 100644 --- a/mlton/main/compile.fun +++ b/mlton/main/compile.fun @@ -40,7 +40,7 @@ structure CoreML = CoreML (open Atoms expandOpaque = true, var = var} - fun layout t = + fun layout t = #1 (layoutPretty (t, {expandOpaque = true, layoutPrettyTycon = Tycon.layout, @@ -118,7 +118,7 @@ fun setCommandLineConstant (c as {name, value}) = set end val () = - case List.peek ([("Exn.keepHistory", + case List.peek ([("Exn.keepHistory", make (Bool.fromString, Control.exnHistory))], fn (s, _) => s = name) of NONE => () @@ -158,7 +158,7 @@ val lookupConstant = fn z => f () z end -(* ------------------------------------------------- *) +(* ------------------------------------------------- *) (* Primitive Env *) (* ------------------------------------------------- *) @@ -216,7 +216,7 @@ local structure Env = struct - open Env + open Env structure Tycon = struct @@ -329,7 +329,7 @@ structure MLBString:> val lexAndParseMLB = MLBString.lexAndParseMLB -val lexAndParseMLB: MLBString.t -> Ast.Basdec.t = +val lexAndParseMLB: MLBString.t -> Ast.Basdec.t = fn input => let val ast = lexAndParseMLB input @@ -411,7 +411,7 @@ fun elaborate {input: MLBString.t}: Xml.Program.t = val _ = case !Control.exportHeader of NONE => () - | SOME f => + | SOME f => File.withOut (f, fn out => let @@ -436,11 +436,11 @@ fun elaborate {input: MLBString.t}: Xml.Program.t = | Control.Executable => "PART_OF" | Control.LibArchive => "NO_DEFAULT_LINK" | Control.Library => "DYNAMIC_LINK" - val _ = + val _ = print ("#if !defined(PART_OF_" ^ libcap ^ ") && \\\n\ \ !defined(STATIC_LINK_" ^ libcap ^ ") && \\\n\ \ !defined(DYNAMIC_LINK_" ^ libcap ^ ")\n") - val _ = + val _ = print ("#define " ^ defaultLinkage ^ "_" ^ libcap ^ "\n") val _ = print "#endif\n" val _ = print "\n" @@ -463,11 +463,11 @@ fun elaborate {input: MLBString.t}: Xml.Program.t = val _ = print "extern \"C\" {\n" val _ = print "#endif\n" val _ = print "\n" - val _ = + val _ = if !Control.format = Control.Executable then () else (print ("MLLIB_PUBLIC(void " ^ libname ^ "_open(int argc, const char** argv);)\n") ;print ("MLLIB_PUBLIC(void " ^ libname ^ "_close();)\n")) - val _ = Ffi.declareHeaders {print = print} + val _ = Ffi.declareHeaders {print = print} val _ = print "\n" val _ = print "#undef MLLIB_PRIVATE\n" val _ = print "#undef MLLIB_PUBLIC\n" @@ -674,7 +674,7 @@ fun makeMachine ssa2 = machine end -fun setupConstants() : unit = +fun setupConstants() : unit = (* Set GC_state offsets and sizes. *) let val _ = @@ -846,7 +846,7 @@ fun genFromSXML (input: File.t): Machine.Program.t = thunk = (fn () => case Parse.parseFile(ParseSxml.program, input) of Result.Yes x => x - | Result.No msg => (Control.error + | Result.No msg => (Control.error (Region.bogus, Layout.str "Sxml Parse failed", Layout.str msg); Control.checkForErrors("parse"); (* can't be reached *) @@ -881,7 +881,7 @@ fun genFromSsa (input: File.t): Machine.Program.t = thunk = (fn () => case Parse.parseFile(ParseSsa.program, input) of Result.Yes x => x - | Result.No msg => (Control.error + | Result.No msg => (Control.error (Region.bogus, Layout.str "Ssa Parse failed", Layout.str msg); Control.checkForErrors("parse"); (* can't be reached *) diff --git a/mlton/main/compile.sig b/mlton/main/compile.sig index c54fd93627..32403c8dab 100644 --- a/mlton/main/compile.sig +++ b/mlton/main/compile.sig @@ -54,7 +54,6 @@ signature COMPILE = outputS: unit -> {file: File.t, print: string -> unit, done: unit -> unit}} -> unit - val compileSSA2: {input: File.t, outputC: unit -> {file: File.t, print: string -> unit, diff --git a/mlton/main/main.fun b/mlton/main/main.fun index 8921d68675..4d03b7a9dc 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -1601,7 +1601,6 @@ fun commandLine (args: string list): unit = mkCompileSrc {listFiles = fn {input} => Vector.new1 input, elaborate = fn _ => raise Fail "Unimplemented", compile = Compile.compileSSA} - val compileSSA2 = mkCompileSrc {listFiles = fn {input} => Vector.new1 input, elaborate = fn _ => raise Fail "Unimplemented", diff --git a/mlton/ssa/parse-ssa.fun b/mlton/ssa/parse-ssa.fun index 38a26233e6..7f262e6441 100644 --- a/mlton/ssa/parse-ssa.fun +++ b/mlton/ssa/parse-ssa.fun @@ -12,7 +12,7 @@ struct open P.Ops infix 1 <|> >>= infix 3 <*> <* *> - infixr 4 <$> <$$> <$$$> <$$$$> <$ <$?> + infixr 4 <$> <$$> <$$$> <$$$$> <$ <$?> fun isInfixChar b = case List.index (String.explode "!%&$#+-/:<=>?@\\~'^|*", @@ -82,7 +82,7 @@ struct (* too many arguments for the maps, curried to use <*> instead *) - fun makeTyp resolveTycon (args, ident) = + fun makeTyp resolveTycon (args, ident) = case ident of "array" => Type.array (Vector.first args) | "intInf" => Type.intInf @@ -166,9 +166,9 @@ struct (* Prim EXP *) - - fun primAppExp resolveTycon resolveVar = - let + + fun primAppExp resolveTycon resolveVar = + let val var = resolveVar <$> ident <* P.spaces val varExp = @@ -199,7 +199,7 @@ struct [CFunction.SymbolScope.External <$ token "external", CFunction.SymbolScope.Private <$ token "private", CFunction.SymbolScope.Public <$ token "public"] - + val parseTarget = CFunction.Target.Indirect <$ symbol "<*>" <|> CFunction.Target.Direct <$> ident @@ -227,7 +227,7 @@ struct <*> fromRecord "symbolScope" parseSymbolScope <* doneRecord) - fun resolvePrim p = + fun resolvePrim p = case Prim.fromString p of SOME p' => P.pure p' | NONE => P.fail ("valid primitive, got " ^ p) @@ -244,7 +244,7 @@ struct P.spaces *> P.tuple varExp <* P.spaces)) end - fun makeStatement (var, ty, exp) = + fun makeStatement (var, ty, exp) = Statement.T {var = var, ty = ty, @@ -262,7 +262,7 @@ struct (SOME <$> var <|> token "_" *> P.pure(NONE), symbol ":" *> (typ resolveTycon) <* P.spaces) fun makeConApp(con, args) = { con=con, args=args } - fun conApp v = + fun conApp v = makeConApp <$$> (resolveCon <$> ident <* P.spaces, v) @@ -274,14 +274,14 @@ struct | Type.Real rs => Const.Real <$> parseReal rs <|> P.failCut "real" | Type.IntInf => Const.IntInf <$> parseIntInf <|> P.failCut "integer" | Type.CPointer => Const.null <$ token "NULL" <|> P.failCut "null" - | Type.Vector _ => + | Type.Vector _ => (* assume it's a word8 vector *) P.any [Const.string <$> parseString, Const.wordVector <$> parseWord8Vector, P.failCut "string constant"] | _ => P.fail "constant" - + fun makeSelect(offset, var) = {offset=offset, tuple=var} val selectExp = symbol "#" *> P.cut(makeSelect <$$> (P.uint <* P.spaces, @@ -302,14 +302,14 @@ struct makeStatement <$> (typedvar >>= (fn (var, ty) => - (symbol "=" *> exp ty <* P.spaces) >>= (fn exp => + (symbol "=" *> exp ty <* P.spaces) >>= (fn exp => P.pure (var, ty, exp)))) in statement' end + - - fun globls resolveCon resolveTycon resolveVar = + fun globls resolveCon resolveTycon resolveVar = let fun globals' () = P.spaces *> token "Globals:" *> Vector.fromList <$> P.many (statements resolveCon resolveTycon resolveVar) @@ -318,7 +318,7 @@ struct end fun makeFunction name args returns raises label blocks = - Function.new + Function.new {args = args, blocks = blocks, mayInline = false, @@ -328,8 +328,8 @@ struct start = label} - fun functns resolveCon resolveTycon resolveVar resolveFunc resolveLabel = - let + fun functns resolveCon resolveTycon resolveVar resolveFunc resolveLabel = + let val name = P.spaces *> symbol "fun" *> resolveFunc <$> ident <* P.spaces @@ -391,13 +391,13 @@ struct ))) val transferCase = Transfer.Case <$> casesExp - - fun makeGoto dst args = + + fun makeGoto dst args = Transfer.Goto {dst = dst, args = args} val transferGoto = makeGoto <$> labelWithArgs - <*> vars + <*> vars fun makeArith (ty, success, {prim, targs = _, args}, overflow) = Transfer.Arith { @@ -414,7 +414,7 @@ struct ")", P.spaces *> P.str "handle Overflow => " *> label' <* P.spaces) - fun makeReturnNonTail cont (handler) = + fun makeReturnNonTail cont (handler) = Return.NonTail { cont=cont, handler= @@ -427,7 +427,7 @@ struct fun returnNonTail cont = makeReturnNonTail cont <$> (P.str "handle _ => " *> ident <* P.spaces) - fun getReturn return = + fun getReturn return = case return of "dead" => P.pure(Return.Dead) | "return" => P.pure(Return.Tail) @@ -438,10 +438,10 @@ struct Transfer.Call { args=args, func=func, - return=return + return=return } - val transferCall = + val transferCall = P.spaces *> P.str "call" *> P.spaces *> ident <* P.spaces >>= (fn return => symbol "(" *> resolveFunc <$> ident <* P.spaces >>= (fn func => vars <* symbol ")" <* P.spaces >>= (fn argus => @@ -475,7 +475,7 @@ struct [transferArith, transferCase, transferCall, transferBug, transferRuntime, transferRaise, transferReturn, transferGoto] - fun makeBlock label args statements transfer = + fun makeBlock label args statements transfer = Block.T { args = args, label = label, @@ -510,8 +510,8 @@ struct {datatypes = datatypes, functions = functions, globals = globals, - main = main} - + main = main} + val program : Program.t Parse.t = let fun strip_unique s = case P.parseString @@ -526,7 +526,7 @@ struct SOME con => con | NONE => resolveCon0 ident val resolveTycon0 = makeNameResolver(Tycon.newString o strip_unique) - fun resolveTycon ident = + fun resolveTycon ident = case ident of "bool" => Tycon.bool | "exn" => Tycon.exn @@ -546,5 +546,5 @@ struct (* failing next to check for end of file *) <* P.spaces <* (P.failing P.next <|> P.failCut "End of file")))) end - + end diff --git a/mlton/ssa/ssa-tree.fun b/mlton/ssa/ssa-tree.fun index 004092b866..faffedb887 100644 --- a/mlton/ssa/ssa-tree.fun +++ b/mlton/ssa/ssa-tree.fun @@ -7,7 +7,7 @@ * See the file MLton-LICENSE for details. *) -functor SsaTree (S: SSA_TREE_STRUCTS): SSA_TREE = +functor SsaTree (S: SSA_TREE_STRUCTS): SSA_TREE = struct open S @@ -232,8 +232,8 @@ structure Cases = fun equals (c1: t, c2: t): bool = let - fun doit (l1, l2, eq') = - Vector.equals + fun doit (l1, l2, eq') = + Vector.equals (l1, l2, fn ((x1, a1), (x2, a2)) => eq' (x1, x2) andalso Label.equals (a1, a2)) in @@ -493,7 +493,7 @@ structure Statement = let val {get = global: Var.t -> Layout.t, set = setGlobal, ...} = Property.getSet (Var.plist, Property.initFun Var.layout) - val _ = + val _ = Vector.foreach (v, fn T {var, exp, ...} => Option.app @@ -507,7 +507,7 @@ structure Statement = val dotsSize = String.size dots val frontSize = 2 * (maxSize - dotsSize) div 3 val backSize = maxSize - dotsSize - frontSize - val s = + val s = if String.size s > maxSize then concat [String.prefix (s, frontSize), dots, @@ -712,7 +712,7 @@ structure Transfer = case t of Arith {args, overflow, success, ...} => (vars args - ; label overflow + ; label overflow ; label success) | Bug => () | Call {func = f, args, return, ...} => @@ -753,15 +753,15 @@ structure Transfer = ty = ty} | Bug => Bug | Call {func, args, return} => - Call {func = func, + Call {func = func, args = fxs args, return = Return.map (return, fl)} | Case {test, cases, default} => - Case {test = fx test, + Case {test = fx test, cases = Cases.map(cases, fl), default = Option.map(default, fl)} - | Goto {dst, args} => - Goto {dst = fl dst, + | Goto {dst, args} => + Goto {dst = fl dst, args = fxs args} | Raise xs => Raise (fxs xs) | Return xs => Return (fxs xs) @@ -851,14 +851,14 @@ structure Transfer = fun equals (e: t, e': t): bool = case (e, e') of (Arith {prim, args, overflow, success, ...}, - Arith {prim = prim', args = args', + Arith {prim = prim', args = args', overflow = overflow', success = success', ...}) => Prim.equals (prim, prim') andalso varsEquals (args, args') andalso Label.equals (overflow, overflow') andalso Label.equals (success, success') | (Bug, Bug) => true - | (Call {func, args, return}, + | (Call {func, args, return}, Call {func = func', args = args', return = return'}) => Func.equals (func, func') andalso varsEquals (args, args') andalso @@ -897,14 +897,14 @@ structure Transfer = | Call {func, args, return} => hashVars (args, hash2 (Func.hash func, Return.hash return)) | Case {test, cases, default} => - hash2 (Var.hash test, + hash2 (Var.hash test, Cases.fold - (cases, + (cases, Option.fold - (default, 0wx55555555, - fn (l, w) => + (default, 0wx55555555, + fn (l, w) => hash2 (Label.hash l, w)), - fn (l, w) => + fn (l, w) => hash2 (Label.hash l, w))) | Goto {dst, args} => hashVars (args, Label.hash dst) @@ -1083,7 +1083,7 @@ structure Function = Vector.foreach (blocks, fn Block.T {args, statements, ...} => (Vector.foreach (args, fx) - ; Vector.foreach (statements, fn Statement.T {var, ty, ...} => + ; Vector.foreach (statements, fn Statement.T {var, ty, ...} => Option.app (var, fn x => fx (x, ty))))) in () @@ -1163,7 +1163,7 @@ structure Function = val _ = Transfer.foreachLabel (transfer, fn to => - (ignore o Graph.addEdge) + (ignore o Graph.addEdge) (g, {from = from, to = labelNode to})) in () @@ -1259,7 +1259,7 @@ structure Function = doit (v, Con.toString) | Cases.Word (_, v) => doit (v, WordX.toString) - val _ = + val _ = case default of NONE => () | SOME j => @@ -1313,7 +1313,7 @@ structure Function = end val controlFlowGraphLayout = Graph.layoutDot - (graph, fn {nodeName} => + (graph, fn {nodeName} => {title = concat [Func.toString name, " control-flow graph"], options = [GraphOption.Rank (Min, [{nodeName = nodeName funNode}])], edgeOptions = edgeOptions, @@ -1470,7 +1470,7 @@ structure Function = local fun make (new, plist) = let - val {get, set, destroy, ...} = + val {get, set, destroy, ...} = Property.destGetSetOnce (plist, Property.initConst NONE) fun bind x = let @@ -1496,24 +1496,24 @@ structure Function = val args = Vector.map (args, fn (x, ty) => (bindVar x, ty)) val bindLabel = ignore o bindLabel val bindVar = ignore o bindVar - val _ = + val _ = Vector.foreach - (blocks, fn Block.T {label, args, statements, ...} => + (blocks, fn Block.T {label, args, statements, ...} => (bindLabel label ; Vector.foreach (args, fn (x, _) => bindVar x) - ; Vector.foreach (statements, - fn Statement.T {var, ...} => + ; Vector.foreach (statements, + fn Statement.T {var, ...} => Option.app (var, bindVar)))) - val blocks = + val blocks = Vector.map (blocks, fn Block.T {label, args, statements, transfer} => Block.T {label = lookupLabel label, args = Vector.map (args, fn (x, ty) => (lookupVar x, ty)), statements = Vector.map - (statements, + (statements, fn Statement.T {var, ty, exp} => - Statement.T + Statement.T {var = Option.map (var, lookupVar), ty = ty, exp = Exp.replaceVar @@ -1537,7 +1537,7 @@ structure Function = if !Control.profile = Control.ProfileNone orelse !Control.profileIL <> Control.ProfileSource then f - else + else let val _ = Control.diagnostic (fn () => layout f) val {args, blocks, mayInline, name, raises, returns, start} = dest f @@ -1590,7 +1590,7 @@ structure Function = : Statement.t vector * Label.t * Handler.t = case raises of NONE => (statements, cont, Handler.Caller) - | SOME ts => + | SOME ts => let val xs = Vector.map (ts, fn _ => Var.newNoname ()) val l = Label.newNoname () @@ -1651,7 +1651,7 @@ structure Function = end) val _ = Vector.foreach (blocks, rem o Block.label) val blocks = Vector.concat [Vector.fromList (!extraBlocks), blocks] - val f = + val f = new {args = args, blocks = blocks, mayInline = mayInline, @@ -1725,7 +1725,7 @@ structure Program = (Node.plist, Property.initFun (fn _ => {nontail = ref false, tail = ref false})) - val _ = + val _ = Vector.foreach (blocks, fn Block.T {transfer, ...} => case transfer of @@ -1778,7 +1778,7 @@ structure Program = (* Layout includes an output function, so we need to rebind output * to the one above. *) - val output = output' + val output = output' in output (str "\n\nDatatypes:") ; Vector.foreach (datatypes, output o Datatype.layout) @@ -1962,7 +1962,7 @@ structure Program = val _ = Array.update (visited, i, true) val f = Vector.sub (functions, i) val v' = v f - val _ = Function.dfs + val _ = Function.dfs (f, fn Block.T {transfer, ...} => (Transfer.foreachFunc (transfer, visit) ; fn () => ())) diff --git a/mlton/ssa/ssa-tree.sig b/mlton/ssa/ssa-tree.sig index 7a1aa36971..cf3048712d 100644 --- a/mlton/ssa/ssa-tree.sig +++ b/mlton/ssa/ssa-tree.sig @@ -7,7 +7,7 @@ * See the file MLton-LICENSE for details. *) -signature SSA_TREE_STRUCTS = +signature SSA_TREE_STRUCTS = sig include ATOMS end @@ -49,7 +49,7 @@ signature RETURN = val map: t * (Label.t -> Label.t) -> t end -signature SSA_TREE = +signature SSA_TREE = sig include SSA_TREE_STRUCTS diff --git a/mlton/ssa/ssa-tree2.fun b/mlton/ssa/ssa-tree2.fun index 5d4358ba7c..ee28c982d5 100644 --- a/mlton/ssa/ssa-tree2.fun +++ b/mlton/ssa/ssa-tree2.fun @@ -7,7 +7,7 @@ * See the file MLton-LICENSE for details. *) -functor SsaTree2 (S: SSA_TREE2_STRUCTS): SSA_TREE2 = +functor SsaTree2 (S: SSA_TREE2_STRUCTS): SSA_TREE2 = struct open S @@ -52,16 +52,15 @@ structure Prod = open Layout in seq [str "(", - (mayAlign o separateRight) - (Vector.toListMap (dest p, fn {elt, isMutable} => - if isMutable - then seq [layout elt, str " ref"] - else layout elt), - ","), - str ")"] + (mayAlign o separateRight) + (Vector.toListMap (dest p, fn {elt, isMutable} => + if isMutable + then seq [layout elt, str " ref"] + else layout elt), + ","), + str ")"] end - val map: 'a t * ('a -> 'b) -> 'b t = fn (p, f) => make (Vector.map (dest p, fn {elt, isMutable} => @@ -71,8 +70,8 @@ structure Prod = val keepAllMap: 'a t * ('a -> 'b option) -> 'b t = fn (p, f) => make (Vector.keepAllMap (dest p, fn {elt, isMutable} => - Option.map (f elt, fn elt => - {elt = elt, + Option.map (f elt, fn elt => + {elt = elt, isMutable = isMutable}))) end @@ -299,25 +298,25 @@ structure Type = Property.initRec (fn (t, layout) => case dest t of - CPointer => str "cpointer" - | Datatype t => Tycon.layout t - | IntInf => str "intInf" - | Object {args, con} => - if isUnit t - then str "unit" - else - let - val args = Prod.layout (args, layout) - in - case con of - Con c => seq [args, str " ", Con.layout c] - | Tuple => seq [args, str " tuple"] - | Sequence => seq [args, str " sequence"] - end - | Real s => str (concat ["real", RealSize.toString s]) - | Thread => str "thread" - | Weak t => seq [str "(", layout t, str ") weak"] - | Word s => str (concat ["word", WordSize.toString s]))) + CPointer => str "cpointer" + | Datatype t => Tycon.layout t + | IntInf => str "intInf" + | Object {args, con} => + if isUnit t + then str "unit" + else + let + val args = Prod.layout (args, layout) + in + case con of + Con c => seq [args, str " ", Con.layout c] + | Sequence => seq [args, str " sequence"] + | Tuple => seq [args, str " tuple"] + end + | Real s => str (concat ["real", RealSize.toString s]) + | Thread => str "thread" + | Weak t => seq [str "(", layout t, str ") weak"] + | Word s => str (concat ["word", WordSize.toString s]))) end fun checkPrimApp {args, prim, result}: bool = @@ -460,8 +459,8 @@ structure Cases = fun equals (c1: t, c2: t): bool = let - fun doit (l1, l2, eq') = - Vector.equals + fun doit (l1, l2, eq') = + Vector.equals (l1, l2, fn ((x1, a1), (x2, a2)) => eq' (x1, x2) andalso Label.equals (a1, a2)) in @@ -634,15 +633,16 @@ structure Exp = | Inject {sum, variant} => seq [str "inj ", paren (layoutVar variant), str ": ", Tycon.layout sum] | Object {con, args} => - seq [str "new ", (case con of - NONE => str "tuple " - | SOME c => seq [Con.layout c, str " "]), - layoutArgs args] + seq [str "new ", + (case con of + NONE => str "tuple " + | SOME c => seq [Con.layout c, str " "]), + layoutArgs args] | PrimApp {args, prim} => seq [str "prim ", Prim.layoutFull (prim, Type.layout), str " ", layoutArgs args] | Select {base, offset} => seq [str "sel ", Int.layout offset, str " ", - paren (Base.layout (base, layoutVar))] + paren (Base.layout (base, layoutVar))] | Var x => layoutVar x end @@ -725,22 +725,26 @@ structure Statement = let val (sep, ty) = if !Control.showTypes - then (str ":", indent (seq [Type.layout ty, str " ="], 2)) - else (str " =", empty) + then (str ":", indent (seq [Type.layout ty, str " ="], 2)) + else (str " =", empty) in - mayAlign [mayAlign [seq [str "val ", - case var of - NONE => str "_" - | SOME var => Var.layout var, sep], ty], - indent (Exp.layout' (exp, layoutVar), 2)] + mayAlign [mayAlign [seq [str "val ", + case var of + NONE => str "_" + | SOME var => Var.layout var, + sep], + ty], + indent (Exp.layout' (exp, layoutVar), 2)] end | Profile p => seq [str "prof ", ProfileExp.layout p] | Update {base, offset, value} => - mayAlign [seq [str "upd ", Exp.layout' (Exp.Select {base = base, - offset = offset}, layoutVar), - str " :="], layoutVar value] + mayAlign [seq [str "upd ", + Exp.layout' (Exp.Select {base = base, + offset = offset}, + layoutVar), + str " :="], + layoutVar value] end - fun layout s = layout' (s, Var.layout) val profile = Profile @@ -756,7 +760,7 @@ structure Statement = let val {get = global: Var.t -> Layout.t, set = setGlobal, ...} = Property.getSet (Var.plist, Property.initFun Var.layout) - val _ = + val _ = Vector.foreach (v, fn s => case s of @@ -772,7 +776,7 @@ structure Statement = val dotsSize = String.size dots val frontSize = 2 * (maxSize - dotsSize) div 3 val backSize = maxSize - dotsSize - frontSize - val s = + val s = if String.size s > maxSize then concat [String.prefix (s, frontSize), dots, @@ -993,7 +997,7 @@ structure Transfer = case t of Arith {args, overflow, success, ...} => (vars args - ; label overflow + ; label overflow ; label success) | Bug => () | Call {func = f, args, return, ...} => @@ -1036,15 +1040,15 @@ structure Transfer = ty = ty} | Bug => Bug | Call {func, args, return} => - Call {func = func, + Call {func = func, args = fxs args, return = Return.map (return, fl)} | Case {test, cases, default} => - Case {test = fx test, + Case {test = fx test, cases = Cases.map(cases, fl), default = Option.map(default, fl)} - | Goto {dst, args} => - Goto {dst = fl dst, + | Goto {dst, args} => + Goto {dst = fl dst, args = fxs args} | Raise xs => Raise (fxs xs) | Return xs => Return (fxs xs) @@ -1068,17 +1072,14 @@ structure Transfer = (l, fn (i, l) => seq [layout i, str " => ", Label.layout l]) datatype z = datatype Cases.t - val suffix = case cases of Con _ => empty | Word (size, _) => str (WordSize.toString size) - val cases = case cases of Con l => doit (l, Con.layout) | Word (_, l) => doit (l, WordX.layout) - val cases = case default of NONE => cases @@ -1138,14 +1139,14 @@ structure Transfer = fun equals (e: t, e': t): bool = case (e, e') of (Arith {prim, args, overflow, success, ...}, - Arith {prim = prim', args = args', + Arith {prim = prim', args = args', overflow = overflow', success = success', ...}) => Prim.equals (prim, prim') andalso varsEquals (args, args') andalso Label.equals (overflow, overflow') andalso Label.equals (success, success') | (Bug, Bug) => true - | (Call {func, args, return}, + | (Call {func, args, return}, Call {func = func', args = args', return = return'}) => Func.equals (func, func') andalso varsEquals (args, args') andalso @@ -1186,14 +1187,14 @@ structure Transfer = | Call {func, args, return} => hashVars (args, hash2 (Func.hash func, Return.hash return)) | Case {test, cases, default} => - hash2 (Var.hash test, + hash2 (Var.hash test, Cases.fold - (cases, + (cases, Option.fold - (default, 0wx55555555, - fn (l, w) => + (default, 0wx55555555, + fn (l, w) => hash2 (Label.hash l, w)), - fn (l, w) => + fn (l, w) => hash2 (Label.hash l, w))) | Goto {dst, args} => hashVars (args, Label.hash dst) @@ -1406,7 +1407,7 @@ structure Function = val _ = Transfer.foreachLabel (transfer, fn to => - (ignore o Graph.addEdge) + (ignore o Graph.addEdge) (g, {from = from, to = labelNode to})) in () @@ -1502,7 +1503,7 @@ structure Function = doit (v, Con.toString) | Cases.Word (_, v) => doit (v, WordX.toString) - val _ = + val _ = case default of NONE => () | SOME j => @@ -1556,7 +1557,7 @@ structure Function = end val controlFlowGraphLayout = Graph.layoutDot - (graph, fn {nodeName} => + (graph, fn {nodeName} => {title = concat [Func.toString name, " control-flow graph"], options = [GraphOption.Rank (Min, [{nodeName = nodeName funNode}])], edgeOptions = edgeOptions, @@ -1713,7 +1714,7 @@ structure Function = local fun make (new, plist) = let - val {get, set, destroy, ...} = + val {get, set, destroy, ...} = Property.destGetSetOnce (plist, Property.initConst NONE) fun bind x = let @@ -1739,14 +1740,14 @@ structure Function = val args = Vector.map (args, fn (x, ty) => (bindVar x, ty)) val bindLabel = ignore o bindLabel val bindVar = ignore o bindVar - val _ = + val _ = Vector.foreach - (blocks, fn Block.T {label, args, statements, ...} => + (blocks, fn Block.T {label, args, statements, ...} => (bindLabel label ; Vector.foreach (args, fn (x, _) => bindVar x) ; Vector.foreach (statements, fn s => Statement.foreachDef (s, bindVar o #1)))) - val blocks = + val blocks = Vector.map (blocks, fn Block.T {label, args, statements, transfer} => Block.T {label = lookupLabel label, @@ -1778,7 +1779,7 @@ structure Function = if !Control.profile = Control.ProfileNone orelse !Control.profileIL <> Control.ProfileSource then f - else + else let val _ = Control.diagnostic (fn () => layout f) val {args, blocks, mayInline, name, raises, returns, start} = dest f @@ -1825,7 +1826,7 @@ structure Function = : Statement.t vector * Label.t * Handler.t = case raises of NONE => (statements, cont, Handler.Caller) - | SOME ts => + | SOME ts => let val xs = Vector.map (ts, fn _ => Var.newNoname ()) val l = Label.newNoname () @@ -1886,7 +1887,7 @@ structure Function = end) val _ = Vector.foreach (blocks, rem o Block.label) val blocks = Vector.concat [Vector.fromList (!extraBlocks), blocks] - val f = + val f = new {args = args, blocks = blocks, mayInline = mayInline, @@ -1960,7 +1961,7 @@ structure Program = (Node.plist, Property.initFun (fn _ => {nontail = ref false, tail = ref false})) - val _ = + val _ = Vector.foreach (blocks, fn Block.T {transfer, ...} => case transfer of @@ -2013,7 +2014,7 @@ structure Program = (* Layout includes an output function, so we need to rebind output * to the one above. *) - val output = output' + val output = output' in output (str "\n\nDatatypes:") ; Vector.foreach (datatypes, output o Datatype.layout) @@ -2193,7 +2194,7 @@ structure Program = val _ = Array.update (visited, i, true) val f = Vector.sub (functions, i) val v' = v f - val _ = Function.dfs + val _ = Function.dfs (f, fn Block.T {transfer, ...} => (Transfer.foreachFunc (transfer, visit) ; fn () => ())) diff --git a/mlton/ssa/ssa-tree2.sig b/mlton/ssa/ssa-tree2.sig index 7623dd3930..4075e3a6ce 100644 --- a/mlton/ssa/ssa-tree2.sig +++ b/mlton/ssa/ssa-tree2.sig @@ -7,12 +7,12 @@ * See the file MLton-LICENSE for details. *) -signature SSA_TREE2_STRUCTS = +signature SSA_TREE2_STRUCTS = sig include ATOMS end -signature SSA_TREE2 = +signature SSA_TREE2 = sig include SSA_TREE2_STRUCTS @@ -185,7 +185,7 @@ signature SSA_TREE2 = test: Var.t} | Goto of {args: Var.t vector, dst: Label.t} - (* Raise implicitly raises to the caller. + (* Raise implicitly raises to the caller. * I.E. the local handler stack must be empty. *) | Raise of Var.t vector @@ -199,7 +199,7 @@ signature SSA_TREE2 = val foreachLabel: t * (Label.t -> unit) -> unit val foreachLabelVar: t * (Label.t -> unit) * (Var.t -> unit) -> unit val foreachVar: t * (Var.t -> unit) -> unit - val hash: t -> Word.t + val hash: t -> Word.t val layout: t -> Layout.t val replaceLabelVar: t * (Label.t -> Label.t) * (Var.t -> Var.t) -> t val replaceLabel: t * (Label.t -> Label.t) -> t diff --git a/mlton/xml/parse-sxml.fun b/mlton/xml/parse-sxml.fun index f2a82546ca..77d9bdfd11 100644 --- a/mlton/xml/parse-sxml.fun +++ b/mlton/xml/parse-sxml.fun @@ -12,7 +12,7 @@ struct open P.Ops infix 1 <|> >>= infix 3 <*> <* *> - infixr 4 <$> <$$> <$$$> <$ <$?> + infixr 4 <$> <$$> <$$$> <$ <$?> fun isInfixChar b = case List.index (String.explode "!%&$#+-/:<=>?@\\~'^|*",