[MLton-commit] r4797
Stephen Weeks
sweeks at mlton.org
Mon Oct 30 14:20:28 PST 2006
Added Javascript manipulation tool.
----------------------------------------------------------------------
A mltonlib/trunk/com/entain/
A mltonlib/trunk/com/entain/javascript/
A mltonlib/trunk/com/entain/javascript/unstable/
A mltonlib/trunk/com/entain/javascript/unstable/LICENSE
A mltonlib/trunk/com/entain/javascript/unstable/Makefile
A mltonlib/trunk/com/entain/javascript/unstable/README
A mltonlib/trunk/com/entain/javascript/unstable/control.fun
A mltonlib/trunk/com/entain/javascript/unstable/control.sig
A mltonlib/trunk/com/entain/javascript/unstable/javascript.fun
A mltonlib/trunk/com/entain/javascript/unstable/javascript.grm
A mltonlib/trunk/com/entain/javascript/unstable/javascript.lex
A mltonlib/trunk/com/entain/javascript/unstable/javascript.mlb
A mltonlib/trunk/com/entain/javascript/unstable/javascript.sig
A mltonlib/trunk/com/entain/javascript/unstable/javascript.sml
A mltonlib/trunk/com/entain/javascript/unstable/join-lattice.fun
A mltonlib/trunk/com/entain/javascript/unstable/join-lattice.sig
A mltonlib/trunk/com/entain/javascript/unstable/lex-internals.sig
A mltonlib/trunk/com/entain/javascript/unstable/lex.fun
A mltonlib/trunk/com/entain/javascript/unstable/lex.sig
A mltonlib/trunk/com/entain/javascript/unstable/lib.mlb
A mltonlib/trunk/com/entain/javascript/unstable/main.sig
A mltonlib/trunk/com/entain/javascript/unstable/main.sml
A mltonlib/trunk/com/entain/javascript/unstable/mjs.mlb
A mltonlib/trunk/com/entain/javascript/unstable/mlb-path-map
A mltonlib/trunk/com/entain/javascript/unstable/parse.fun
A mltonlib/trunk/com/entain/javascript/unstable/parse.sig
A mltonlib/trunk/com/entain/javascript/unstable/regexp.fun
A mltonlib/trunk/com/entain/javascript/unstable/regexp.sig
A mltonlib/trunk/com/entain/javascript/unstable/region.fun
A mltonlib/trunk/com/entain/javascript/unstable/region.sig
A mltonlib/trunk/com/entain/javascript/unstable/source-pos.fun
A mltonlib/trunk/com/entain/javascript/unstable/source-pos.sig
A mltonlib/trunk/com/entain/javascript/unstable/source.fun
A mltonlib/trunk/com/entain/javascript/unstable/source.sig
A mltonlib/trunk/com/entain/javascript/unstable/stream.sig
A mltonlib/trunk/com/entain/javascript/unstable/stream.sml
A mltonlib/trunk/com/entain/javascript/unstable/token.fun
A mltonlib/trunk/com/entain/javascript/unstable/token.sig
A mltonlib/trunk/com/entain/javascript/unstable/top-down-parser.fun
A mltonlib/trunk/com/entain/javascript/unstable/top-down-parser.mlb
A mltonlib/trunk/com/entain/javascript/unstable/top-down-parser.sig
A mltonlib/trunk/com/entain/javascript/unstable/top-down-parser.sml
A mltonlib/trunk/com/entain/javascript/unstable/two-point-lattice.fun
A mltonlib/trunk/com/entain/javascript/unstable/two-point-lattice.sig
A mltonlib/trunk/com/entain/javascript/unstable/util.sml
----------------------------------------------------------------------
Property changes on: mltonlib/trunk/com/entain/javascript/unstable
___________________________________________________________________
Name: svn:ignore
+ mjs
lex-internals.fun
Added: mltonlib/trunk/com/entain/javascript/unstable/LICENSE
===================================================================
--- mltonlib/trunk/com/entain/javascript/unstable/LICENSE 2006-10-29 18:53:30 UTC (rev 4796)
+++ mltonlib/trunk/com/entain/javascript/unstable/LICENSE 2006-10-30 22:20:10 UTC (rev 4797)
@@ -0,0 +1,20 @@
+COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
+
+Copyright (C) 2006 Entain, Inc.
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both the copyright notice and this permission notice and warranty
+disclaimer appear in supporting documentation, and that the name of
+the above copyright holders, or their entities, not be used in
+advertising or publicity pertaining to distribution of the software
+without specific, written prior permission.
+
+The above copyright holders disclaim all warranties with regard to
+this software, including all implied warranties of merchantability and
+fitness. In no event shall the above copyright holders be liable for
+any special, indirect or consequential damages or any damages
+whatsoever resulting from loss of use, data or profits, whether in an
+action of contract, negligence or other tortious action, arising out
+of or in connection with the use or performance of this software.
Added: mltonlib/trunk/com/entain/javascript/unstable/Makefile
===================================================================
--- mltonlib/trunk/com/entain/javascript/unstable/Makefile 2006-10-29 18:53:30 UTC (rev 4796)
+++ mltonlib/trunk/com/entain/javascript/unstable/Makefile 2006-10-30 22:20:10 UTC (rev 4797)
@@ -0,0 +1,30 @@
+# Copyright (C) 2006 Entain, Inc.
+#
+# This code is released under the MLton license, a BSD-style license.
+# See the LICENSE file or http://mlton.org/License for details.
+#
+
+NAME = mjs
+MLTON = mlton -mlb-path-map mlb-path-map
+FLAGS = \
+ -const 'Exn.keepHistory true' \
+ -verbose 1
+LEXER = lex-internals.fun
+EXE=$(NAME)
+
+.PHONY: all
+all: $(EXE)
+
+$(EXE): $(shell $(MLTON) -stop f $(NAME).mlb)
+ time $(MLTON) $(FLAGS) -output $(EXE) $(NAME).mlb
+
+$(LEXER): javascript.lex
+ rm -f $(LEXER)
+ mllex javascript.lex
+ mv javascript.lex.sml $(LEXER)
+ chmod -w $(LEXER)
+
+javascript.grm.sig javascript.grm.sml: javascript.grm
+ rm -f javascript.grm.*
+ mlyacc javascript.grm
+ chmod -w javascript.grm.*
Added: mltonlib/trunk/com/entain/javascript/unstable/README
===================================================================
--- mltonlib/trunk/com/entain/javascript/unstable/README 2006-10-29 18:53:30 UTC (rev 4796)
+++ mltonlib/trunk/com/entain/javascript/unstable/README 2006-10-30 22:20:10 UTC (rev 4797)
@@ -0,0 +1,107 @@
+This directory contains SML code for tools (compressor, lexer, parser,
+pretty-printer) to manipulate Javascript, as specified by:
+
+ ECMAScript Language Specification
+ Edition 3 Final
+ 24 March 2000
+
+This directory includes:
+
+ * An ML-Lex specification for Javascript tokens.
+ * An ML-Yacc specification for Javascript.
+ * A hand-crafted top-down-parser generator.
+ * A specification of Javascript's grammar that works with the
+ top-down-parser generator.
+ * Datatypes for Javascript tokens and abstract syntax trees.
+ * A command-line tool for Javascript compression, tokenization,
+ parsing, and pretty printing.
+
+The ML-Yacc parser works except that it doesn't handle semicolon
+insertion. It is not used. Instead, the top-down parser is used.
+
+The code is available under the MLton license. See the LICENSE file
+or http://mlton.org/License .
+
+----------------------------------------
+Command-line tool
+----------------------------------------
+
+The command-line tool compresses, parses, or tokenizes a Javascript
+file. The usage is
+
+ mjs {compress|parse|tokenize} <file>
+
+where <file> is a file containing Javascript code.
+
+(The mnemonic for "mjs" is "Manipulate JavaScript")
+
+----------------------------------------
+Building the tool
+----------------------------------------
+
+This code compiles with MLton and uses the MLton library that lives in
+the MLton SVN.
+
+ svn://mlton.org/mlton/trunk/lib/mlton
+
+To compile, you must set the MLB Path variable "MLTON_LIB" to point
+at a local copy of that directory. This code works with the MLton
+library as of 2006-10-30. To set MLTON_LIB, edit the mlb-path-map
+file. Once you've set that correctly, you should be able to type
+"make" and watch MLton build the "mjs" executable.
+
+----------------------------------------
+Files in this directory.
+----------------------------------------
+
+control.{fun,sig}
+ Switches to control behavior.
+javascript.grm
+ ML-Yacc specification for Javascript.
+javascript.lex
+ ML-Lex specification for Javascript.
+javascript.{mlb}
+ MLB library file for Javasscript
+javascript.{fun,sig}
+ Abstract syntax trees for Javascript.
+javascript.sml
+ Apply functors to build the syntax trees and parser.
+join-lattice.{fun,sig}
+ A simple lattce constraint solver.
+lex.{fun,sig}
+ Wrapper around the ML-Lex generated lexer.
+lex-internals.sig
+ Specifies the routines needed within the ML-Lex specification.
+lib.mlb
+ MLB library file to import the MLton library.
+LICENSE
+ The MLton license, under which this code is released.
+main.{sig,sml}
+ The command-line tool.
+Makefile
+ Build lexer, parser, and command-line tool.
+mjs.mlb
+ Build file for the command-line tool.
+parse.{fun,sig}
+ A top-down parser for Javascript, implementing using the top-down
+ parser generator.
+README
+ This file.
+regexp.{fun,sig}
+ Syntax for Javascript regexps
+region.{fun,sig}
+ Regions of source code (taken from MLton).
+source.{fun,sig}
+ Source files (taken from MLton).
+source-pos.{fun,sig}.
+ Source code positions (taken from MLton).
+stream.{sig,sml}
+ Polymorphic sequence type.
+token.{fun,sig}
+ Javascript tokens.
+top-down-parser.{fun,mlb,sig,sml}
+ A top-down-parser generator.
+two-point-lattice.{fun,sig}
+ A simple lattice constraint solver.
+util.sml
+ A couple of string utilities.
Added: mltonlib/trunk/com/entain/javascript/unstable/control.fun
===================================================================
--- mltonlib/trunk/com/entain/javascript/unstable/control.fun 2006-10-29 18:53:30 UTC (rev 4796)
+++ mltonlib/trunk/com/entain/javascript/unstable/control.fun 2006-10-30 22:20:10 UTC (rev 4797)
@@ -0,0 +1,65 @@
+(* Copyright (C) 2006 Entain, Inc.
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+functor Control (S: CONTROL_STRUCTS): CONTROL =
+struct
+
+open S
+
+local
+ open Region
+in
+ structure SourcePos = SourcePos
+end
+
+val acceptMozillaExtensions = ref false
+
+val numErrors: int ref = ref 0
+
+val errorThreshhold: int ref = ref 20
+
+val die = Process.fail
+
+local
+ fun msg (kind: string, r: Region.t, msg: Layout.t, extra: Layout.t): unit =
+ let
+ open Layout
+ val p =
+ case Region.left r of
+ NONE => "<bogus>"
+ | SOME p => SourcePos.toString p
+ val msg = Layout.toString msg
+ val msg =
+ Layout.str
+ (concat [String.fromChar (Char.toUpper (String.sub (msg, 0))),
+ String.dropPrefix (msg, 1),
+ "."])
+ in
+ outputl (align [seq [str (concat [kind, ": "]), str p, str "."],
+ indent (align [msg,
+ indent (extra, 2)],
+ 2)],
+ Out.error)
+ end
+in
+ fun error (r, m, e) =
+ let
+ val _ = Int.inc numErrors
+ val _ = msg ("Error", r, m, e)
+ in
+ if !numErrors = !errorThreshhold
+ then die "compilation aborted: too many errors"
+ else ()
+ end
+end
+
+fun errorStr (r, msg) = error (r, Layout.str msg, Layout.empty)
+
+end
+
+structure SourcePos = SourcePos ()
+structure Region = Region (structure SourcePos = SourcePos)
+structure Control = Control (structure Region = Region)
Added: mltonlib/trunk/com/entain/javascript/unstable/control.sig
===================================================================
--- mltonlib/trunk/com/entain/javascript/unstable/control.sig 2006-10-29 18:53:30 UTC (rev 4796)
+++ mltonlib/trunk/com/entain/javascript/unstable/control.sig 2006-10-30 22:20:10 UTC (rev 4797)
@@ -0,0 +1,18 @@
+(* Copyright (C) 2006 Entain, Inc.
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature CONTROL_STRUCTS =
+ sig
+ structure Region: REGION
+ end
+
+signature CONTROL =
+ sig
+ include CONTROL_STRUCTS
+
+ val acceptMozillaExtensions: bool ref
+ val errorStr: Region.t * string -> unit
+ end
Added: mltonlib/trunk/com/entain/javascript/unstable/javascript.fun
===================================================================
--- mltonlib/trunk/com/entain/javascript/unstable/javascript.fun 2006-10-29 18:53:30 UTC (rev 4796)
+++ mltonlib/trunk/com/entain/javascript/unstable/javascript.fun 2006-10-30 22:20:10 UTC (rev 4797)
@@ -0,0 +1,1178 @@
+(* Copyright (C) 2006 Entain, Inc.
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+functor Javascript (S: JAVASCRIPT_STRUCTS): JAVASCRIPT =
+struct
+
+open S
+
+structure Pervasive =
+ struct
+ structure String = String
+ end
+
+structure Id =
+ struct
+ datatype t = T of string
+
+ fun equals (T s, T s') = s = s'
+
+ val fromString = T
+
+ fun toString (T s) = s
+
+ val layout = Layout.str o toString
+ end
+
+structure AssignOp =
+ struct
+ datatype t =
+ Add
+ | BitwiseAnd
+ | BitwiseOr
+ | BitwiseXor
+ | Div
+ | Equals
+ | LeftShift
+ | Mul
+ | Mod
+ | RightShiftSigned
+ | RightShiftUnsigned
+ | Sub
+
+ val toString =
+ fn Add => "+="
+ | BitwiseAnd => "&="
+ | BitwiseOr => "|="
+ | BitwiseXor => "^="
+ | Div => "/="
+ | Equals => "="
+ | LeftShift => "<<="
+ | Mul => "*="
+ | Mod => "%="
+ | RightShiftSigned => ">>="
+ | RightShiftUnsigned => ">>>="
+ | Sub => "-="
+
+ val layout = Layout.str o toString
+ end
+
+structure BinaryOp =
+ struct
+ datatype t =
+ Add
+ | BitwiseAnd
+ | BitwiseOr
+ | BitwiseXor
+ | Div
+ | Equals
+ | GreaterThan
+ | GreaterThanEqual
+ | In
+ | InstanceOf
+ | LeftShift
+ | LessThan
+ | LessThanEqual
+ | LogicalAnd
+ | LogicalOr
+ | Mod
+ | Mul
+ | NotEquals
+ | RightShiftSigned
+ | RightShiftUnsigned
+ | StrictEquals
+ | StrictNotEquals
+ | Sub
+
+ val toString =
+ fn Add => "+"
+ | BitwiseAnd => "&"
+ | BitwiseOr => "|"
+ | BitwiseXor => "^"
+ | Div => "/"
+ | Equals => "=="
+ | GreaterThan => ">"
+ | GreaterThanEqual => ">="
+ | In => "in"
+ | InstanceOf => "instanceof"
+ | LeftShift => "<<"
+ | LessThan => "<"
+ | LessThanEqual => "<="
+ | LogicalAnd => "&&"
+ | LogicalOr => "||"
+ | Mod => "%"
+ | Mul => "*"
+ | NotEquals => "!="
+ | RightShiftSigned => ">>"
+ | RightShiftUnsigned => ">>>"
+ | StrictEquals => "==="
+ | StrictNotEquals => "!=="
+ | Sub => "-"
+
+ val layout = Layout.str o toString
+
+ val equals: t * t -> bool = op =
+
+ val precedences: t list list =
+ [[Div, Mod, Mul],
+ [Add, Sub],
+ [LeftShift, RightShiftSigned, RightShiftUnsigned],
+ [GreaterThan, GreaterThanEqual, LessThan, LessThanEqual, In,
+ InstanceOf],
+ [Equals, NotEquals, StrictEquals, StrictNotEquals],
+ [BitwiseAnd],
+ [BitwiseXor],
+ [BitwiseOr],
+ [LogicalAnd],
+ [LogicalOr]]
+
+ val precedencesRev = rev precedences
+ end
+
+structure UnaryOp =
+ struct
+ datatype t =
+ Add
+ | BitwiseNot
+ | Delete
+ | LogicalNot
+ | Neg
+ | PreDecrement
+ | PreIncrement
+ | PostDecrement
+ | PostIncrement
+ | TypeOf
+ | Void
+
+ val hasSideEffect =
+ fn PreDecrement => true
+ | PreIncrement => true
+ | PostDecrement => true
+ | PostIncrement => true
+ | _ => false
+
+ val isAlphaNumeric =
+ fn Delete => true
+ | TypeOf => true
+ | Void => true
+ | _ => false
+
+ val isSymbolic = not o isAlphaNumeric
+
+ fun mustSeparate (o1, o2) =
+ if isAlphaNumeric o1
+ then isAlphaNumeric o2
+ else
+ case (o1, o2) of
+ (Add, Add) => true
+ | (Add, PreIncrement) => true
+ | (Neg, Neg) => true
+ | (Neg, PreDecrement) => true
+ | _ => false
+
+ val toString =
+ fn Add => "+"
+ | BitwiseNot => "~"
+ | Delete => "delete"
+ | LogicalNot => "!"
+ | Neg => "-"
+ | PreDecrement => "--"
+ | PreIncrement => "++"
+ | PostDecrement => "--"
+ | PostIncrement => "++"
+ | TypeOf => "typeof"
+ | Void => "void"
+
+ val layout = Layout.str o toString
+
+ val isPostfix =
+ fn PostDecrement => true
+ | PostIncrement => true
+ | _ => false
+
+ val isPrefix = not o isPostfix
+ end
+
+structure Number =
+ struct
+ datatype t = T of Real.t
+
+ fun equals (T r, T r') = Real.equals (r, r')
+
+ fun fromReal r = if r < 0.0 then Error.bug "Number.fromReal" else T r
+
+ val toReal = fn T r => r
+
+ val fromInt = fromReal o Int.toReal
+
+ val zero = fromInt 0
+
+ fun isZero n = equals (n, zero)
+
+ fun toString (T r) = Util.realToJavascript r
+
+ val layout = Layout.str o toString
+ end
+
+structure String =
+ struct
+ datatype t = T of word vector
+
+ val make = T
+
+ fun fromString s =
+ T (Vector.tabulate
+ (String.size s, fn i =>
+ Word.fromInt (Char.toInt (String.sub (s, i)))))
+
+ fun escape (T ws) = Util.escapeJavascript ws
+
+ fun toString (T ws) =
+ String.tabulate (Vector.length ws, fn i =>
+ Char.fromInt (Word.toInt (Vector.sub (ws, i))))
+
+ val layout = Layout.str o escape
+
+ val w2c = Char.fromInt o Word.toInt
+
+ val keywords =
+ ["true", "false", "break", "case", "catch", "const", "continue",
+ "default", "delete", "do", "else", "finally", "for", "function",
+ "if", "in", "instanceof", "new", "null", "return", "switch", "this",
+ "throw", "tilde", "try", "typeof", "var", "void", "while", "with"]
+
+ local
+ val set = HashSet.new {hash = #hash}
+ val () =
+ List.foreach
+ (keywords, fn s =>
+ let
+ val hash = String.hash s
+ in
+ ignore
+ (HashSet.lookupOrInsert
+ (set, hash, fn {string = s', ...} => s = s',
+ fn () => {hash = hash, string = s}))
+ end)
+ in
+ fun isKeyword s =
+ isSome
+ (HashSet.peek (set, String.hash s, fn {string = s', ...} => s = s'))
+ end
+
+ fun isValidIdentifier (T ws) =
+ 0 < Vector.length ws
+ andalso
+ let
+ fun isOk c = Char.isAlphaNum c orelse c = #"_" orelse c = #"$"
+ in
+ (isOk (w2c (Vector.sub (ws, 0)))
+ andalso Vector.forall (ws, fn w =>
+ let
+ val c = w2c w
+ in
+ isOk c orelse Char.isDigit c
+ end)
+ andalso not (isKeyword (String.tabulate
+ (Vector.length ws, fn i =>
+ w2c (Vector.sub (ws, i))))))
+ handle Chr => false
+ end
+
+ fun layoutAsPropertyName (s: t): Layout.t =
+ if isValidIdentifier s
+ then Layout.str (toString s)
+ else layout s
+ end
+
+structure PropertyName =
+ struct
+ datatype t =
+ Number of Number.t
+ | String of String.t
+
+ val layout =
+ fn Number n => Number.layout n
+ | String s => String.layoutAsPropertyName s
+
+ val fromInt = Number o Number.fromInt
+
+ val fromString = String o String.fromString
+ end
+
+structure Joint =
+ struct
+ datatype exp =
+ Array of exp option vector
+ | Assign of {lhs: exp,
+ oper: AssignOp.t,
+ rhs: exp}
+ | Bool of bool
+ | Binary of {lhs: exp,
+ oper: BinaryOp.t,
+ rhs: exp}
+ | Call of {args: exp vector,
+ func: exp}
+ | Cond of {elsee: exp,
+ test: exp,
+ thenn: exp}
+ | Function of {args: Id.t vector,
+ body: statement vector,
+ name: Id.t option}
+ | Id of Id.t
+ | New of {args: exp vector,
+ object: exp}
+ | Number of Number.t
+ | Null
+ | Object of objectInit vector
+ | Regexp of Regexp.t
+ | Seq of exp vector
+ | Select of {object: exp,
+ property: exp}
+ | SelectId of {object: exp,
+ property: Id.t}
+ | String of String.t
+ | Unary of {exp: exp,
+ oper: UnaryOp.t}
+ | This
+
+ and objectInit =
+ Get of {args: Id.t vector,
+ body: statement vector,
+ name: Id.t}
+ | Property of {property: PropertyName.t,
+ value: exp}
+ | Set of {args: Id.t vector,
+ body: statement vector,
+ name: Id.t}
+
+ and statement =
+ Block of statement vector
+ | Break of Id.t option
+ | Const of (Id.t * exp) vector
+ | Continue of Id.t option
+ | Do of {body: statement,
+ test: exp}
+ | Empty
+ | Exp of exp
+ | For of {body: statement,
+ inc: exp option,
+ init: exp option,
+ test: exp option}
+ | ForIn of {body: statement,
+ lhs: exp,
+ object: exp}
+ | ForVar of {body: statement,
+ inc: exp option,
+ init: (Id.t * exp option) vector,
+ test: exp option}
+ | ForVarIn of {body: statement,
+ id: Id.t,
+ init: exp option,
+ object: exp}
+ | FunctionDec of {args: Id.t vector,
+ body: statement vector,
+ name: Id.t}
+ | If of {elsee: statement option,
+ test: exp,
+ thenn: statement}
+ | Labeled of Id.t * statement
+ | Return of exp option
+ | Switch of {clauses: (exp option * statement vector) vector,
+ test: exp}
+ | Throw of exp
+ | Try of {body: statement vector,
+ catch: (Id.t * statement vector) option,
+ finally: statement vector option}
+ | Var of (Id.t * exp option) vector
+ | While of {body: statement,
+ test: exp}
+ | With of {body: statement,
+ object: exp}
+ end
+
+structure Exp =
+ struct
+ datatype t = datatype Joint.exp
+ end
+
+structure Statement =
+ struct
+ datatype t = datatype Joint.statement
+ end
+
+structure ObjectInit =
+ struct
+ datatype dest = datatype Joint.objectInit
+ datatype t = datatype dest
+ end
+
+structure Joint =
+ struct
+ open Joint
+
+ local
+ open Layout
+ in
+ fun commaList (v: 'a vector, lay: 'a -> Layout.t): Layout.t =
+ mayAlign (separateRight (Vector.toListMap (v, lay), ","))
+
+ fun for (iter, body) =
+ layoutStatementIn (body, seq [str "for ", paren iter], NONE)
+
+ and layoutArguments es =
+ paren (commaList (es, layoutAssignmentExp))
+
+ and layoutAssignmentExp e =
+ layoutAssignmentExpGen (e, {isStatement = false,
+ mayHaveIn = true})
+
+ and layoutAssignmentExpGen (e, {isStatement, mayHaveIn}) =
+ case e of
+ Assign {lhs, oper, rhs} =>
+ mayAlign [seq [layoutLeftHandSideExp
+ (lhs, {isStatement = isStatement}),
+ str " ", AssignOp.layout oper],
+ indent (layoutAssignmentExpGen
+ (rhs, {isStatement = false,
+ mayHaveIn = mayHaveIn}),
+ 2)]
+ | _ => layoutConditionalExp (e, {isStatement = isStatement,
+ mayHaveIn = mayHaveIn})
+
+ and layoutBinaryExp (e: Exp.t, {isStatement, mayHaveIn}) : Layout.t =
+ let
+ fun loop arg: Layout.t =
+ Trace.trace3
+ ("loop", Layout.ignore, Layout.ignore,
+ List.layout (List.layout BinaryOp.layout),
+ fn l => l)
+ (fn (e: Exp.t, {isStatement}, opers) =>
+ case e of
+ Binary {lhs, oper, rhs} =>
+ if not mayHaveIn
+ andalso BinaryOp.equals (oper, BinaryOp.In)
+ then layoutUnaryExp (e, {isStatement = isStatement})
+ else
+ let
+ fun loop' opers' =
+ case opers' of
+ [] =>
+ layoutUnaryExp
+ (e, {isStatement = isStatement})
+ | z :: opers'' =>
+ if List.exists
+ (z, fn oper' =>
+ BinaryOp.equals (oper, oper'))
+ then (mayAlign
+ [loop
+ (lhs,
+ {isStatement = isStatement},
+ opers'),
+ seq [BinaryOp.layout oper,
+ str " ",
+ loop (rhs,
+ {isStatement = false},
+ opers'')]])
+ else loop' opers''
+ in
+ loop' opers
+ end
+ | _ => layoutUnaryExp (e, {isStatement = isStatement}))
+ arg
+ in
+ loop (e, {isStatement = isStatement}, BinaryOp.precedencesRev)
+ end
+
+ and layoutCall (f, args) =
+ mayAlign [f, indent (layoutArguments args, 2)]
+
+ and layoutSelect (object, property) =
+ seq [object, str "[", layoutExp property, str "]"]
+
+ and layoutSelectId (object, property) =
+ seq [object, str ".", Id.layout property]
+
+ and layoutConditionalExp (e, z as {isStatement = _, mayHaveIn}) =
+ case e of
+ Cond {elsee, test, thenn} =>
+ let
+ val mhi = {isStatement = false,
+ mayHaveIn = mayHaveIn}
+ in
+ align [layoutBinaryExp (test, z),
+ seq [str "? ", layoutAssignmentExpGen (thenn, mhi)],
+ seq [str ": ", layoutAssignmentExpGen (elsee, mhi)]]
+ end
+ | _ => layoutBinaryExp (e, z)
+
+ and layoutExp e =
+ layoutExpGen (e, {isStatement = false, mayHaveIn = true})
+
+ and layoutExpGen (e, {isStatement, mayHaveIn}) =
+ case e of
+ Seq es =>
+ commaList
+ (Vector.mapi
+ (es, fn (i, e) =>
+ layoutAssignmentExpGen
+ (e, {isStatement = isStatement andalso i = 0,
+ mayHaveIn = mayHaveIn})),
+ fn z => z)
+ | _ => layoutAssignmentExpGen (e, {isStatement = isStatement,
+ mayHaveIn = mayHaveIn})
+
+ and layoutExpOpt eo =
+ case eo of
+ NONE => empty
+ | SOME e => layoutExp e
+
+ and layoutExpNoInOpt eo =
+ case eo of
+ NONE => empty
+ | SOME e => layoutExpGen (e, {isStatement = false,
+ mayHaveIn = false})
+
+ and layoutFunction (keyword, {args, body, name}) =
+ align [seq [str keyword,
+ case name of
+ NONE => empty
+ | SOME id => seq [str " ", Id.layout id],
+ str " ", tuple (Vector.toListMap (args, Id.layout)),
+ str " {"],
+ indent (layoutStatements body, 2),
+ str "}"]
+
+ and layoutLeftHandSideExp (e, {isStatement}) =
+ case e of
+ New _ => layoutNewExp e
+ | _ =>
+ let
+ fun loop (e, {precedesDot}) =
+ case e of
+ Call {args, func} =>
+ layoutCall (loop (func,
+ {precedesDot = false}),
+ args)
+ | Select {object, property} =>
+ layoutSelect (loop (object,
+ {precedesDot = false}),
+ property)
+ | SelectId {object, property} =>
+ layoutSelectId (loop (object,
+ {precedesDot = true}),
+ property)
+ | _ => layoutMemberExp (e, {isStatement = isStatement,
+ precedesDot = precedesDot})
+ in
+ loop (e, {precedesDot = false})
+ end
+
+ and layoutMemberExp (e, {isStatement, precedesDot}) =
+ case e of
+ New {args, object} =>
+ seq [str "new ",
+ layoutMemberExp (object, {isStatement = false,
+ precedesDot = false}),
+ layoutArguments args]
+ | Function z =>
+ let
+ val f = layoutFunction ("function", z)
+ in
+ if isStatement then paren f else f
+ end
+ | Select {object, property} =>
+ layoutSelect (layoutMemberExp (object,
+ {isStatement = isStatement,
+ precedesDot = false}),
+ property)
+ | SelectId {object, property} =>
+ layoutSelectId (layoutMemberExp (object,
+ {isStatement = isStatement,
+ precedesDot = true}),
+ property)
+ | _ => layoutPrimaryExp (e, {isStatement = isStatement,
+ precedesDot = precedesDot})
+
+ and layoutNewExp e =
+ case e of
+ New {args, object} =>
+ seq [str "new ",
+ if 0 = Vector.length args
+ then layoutNewExp object
+ else seq [layoutMemberExp (object,
+ {isStatement = false,
+ precedesDot = false}),
+ layoutArguments args]]
+ | _ => layoutMemberExp (e, {isStatement = false,
+ precedesDot = false})
+
+ and layoutPostfixExp (e, is) =
+ case e of
+ Unary {exp, oper} =>
+ if UnaryOp.isPostfix oper
+ then seq [layoutLeftHandSideExp (exp, is),
+ UnaryOp.layout oper]
+ else layoutLeftHandSideExp (e, is)
+ | _ => layoutLeftHandSideExp (e, is)
+
+ and layoutPrimaryExp (e, {isStatement, precedesDot}) =
+ case e of
+ Array es =>
+ seq [str "[",
+ seq (rev
+ (#2
+ (Vector.fold
+ (es, (false, []), fn (eo, (z, ac)) =>
+ let
+ val ac = str (if z then "," else "") :: ac
+ in
+ case eo of
+ NONE => (false, str "," :: ac)
+ | SOME e =>
+ (true, layoutAssignmentExp e :: ac)
+ end)))),
+ str "]"]
+ | Bool b => Bool.layout b
+ | Id id => Id.layout id
+ | Number n =>
+ let
+ val s = Number.toString n
+ in
+ if precedesDot
+ andalso not (Pervasive.String.contains (s, #".")) then
+ paren (str s)
+ else str s
+ end
+ | Null => str "null"
+ | Object inits =>
+ let
+ val z =
+ seq [str "{",
+ commaList (inits, layoutObjectInit),
+ str "}"]
+ in
+ if isStatement then paren z else z
+ end
+ | Regexp r => Regexp.layout r
+ | String s => String.layout s
+ | This => str "this"
+ | _ => paren (layoutExp e)
+
+ and layoutObjectInit oi =
+ case oi of
+ Get {args, body, name} =>
+ layoutFunction ("get", {args = args,
+ body = body,
+ name = SOME name})
+ | Property {property, value} =>
+ seq [PropertyName.layout property,
+ str ": ",
+ layoutAssignmentExp value]
+ | Set {args, body, name} =>
+ layoutFunction ("set", {args = args,
+ body = body,
+ name = SOME name})
+
+ and layoutStatementStart (s, pre: Layout.t)
+ : Layout.t * Layout.t option =
+ case s of
+ Block ss =>
+ (align [seq [pre, str " {"],
+ indent (align (Vector.toListMap
+ (ss, layoutStatement)),
+ 2)],
+ SOME (str "}"))
+ | _ => (align [pre, indent (layoutStatement s, 2)],
+ NONE)
+
+ and combine (l: Layout.t option, l': Layout.t option) =
+ case (l, l') of
+ (NONE, NONE) => NONE
+ | (SOME l, NONE) => SOME l
+ | (NONE, SOME l') => SOME l'
+ | (SOME l, SOME l') => SOME (seq [l, str " ", l'])
+
+ and layoutStatementIn (s, pre: Layout.t, suf: Layout.t option)
+ : Layout.t =
+ let
+ val (l, suf0) = layoutStatementStart (s, pre)
+ in
+ case combine (suf0, suf) of
+ NONE => l
+ | SOME suf => align [l, suf]
+ end
+
+ and layoutStatement (s: Statement.t): Layout.t =
+ case s of
+ Block ss =>
+ align [str "{", indent (layoutStatements ss, 2), str "}"]
+ | Break ido =>
+ seq [str "break",
+ case ido of
+ NONE => empty
+ | SOME id => seq [str " ", Id.layout id],
+ str ";"]
+ | Const ds =>
+ seq [str "const ",
+ commaList (ds, fn (x, e) =>
+ layoutVariableDeclaration (x, SOME e)),
+ str ";"]
+ | Continue ido =>
+ seq [str "continue",
+ case ido of
+ NONE => empty
+ | SOME id => seq [str " ", Id.layout id],
+ str ";"]
+ | Do {body, test} =>
+ layoutStatementIn
+ (body, str "do",
+ SOME (seq [str "while ", paren (layoutExp test), str ";"]))
+ | Empty => str ";"
+ | Exp e =>
+ seq [layoutExpGen (e, {isStatement = true,
+ mayHaveIn = true}),
+ str ";"]
+ | For {body, inc, init, test} =>
+ for (mayAlign [seq [layoutExpNoInOpt init, str ";"],
+ seq [layoutExpOpt test, str ";"],
+ layoutExpOpt inc],
+ body)
+ | ForIn {body, lhs, object} =>
+ for (seq [layoutLeftHandSideExp (lhs, {isStatement = false}),
+ str " in ",
+ layoutExp object],
+ body)
+ | ForVar {body, inc, init, test} =>
+ for (mayAlign
+ [seq [str "var ",
+ commaList (init, layoutVariableDeclarationNoIn),
+ str ";"],
+ seq [layoutExpOpt test, str ";"],
+ layoutExpOpt inc],
+ body)
+ | ForVarIn {body, id, init, object} =>
+ for (seq [str "var ",
+ layoutVariableDeclarationNoIn (id, init),
+ str " in ",
+ layoutExp object],
+ body)
+ | FunctionDec {args, body, name} =>
+ layoutFunction ("function",
+ {args = args,
+ body = body,
+ name = SOME name})
+ | If {elsee, test, thenn} =>
+ let
+ fun loop (pre, test, thenn, elsee) =
+ let
+ fun catchesElse s =
+ case s of
+ If {elsee, thenn, ...} =>
+ (case elsee of
+ NONE => true
+ | SOME e => catchesElse e)
+ | _ => false
+ val thenn =
+ if isSome elsee andalso catchesElse thenn then
+ Block (Vector.new1 thenn)
+ else
+ thenn
+ val (pre, suf) =
+ layoutStatementStart
+ (thenn,
+ seq [pre, str "if ", paren (layoutExp test)])
+ in
+ case elsee of
+ NONE =>
+ (case suf of
+ NONE => pre
+ | SOME suf => align [pre, suf])
+ | SOME s =>
+ align
+ [pre,
+ let
+ val e =
+ valOf (combine (suf, SOME (str "else")))
+ in
+ case s of
+ If {elsee, test, thenn} =>
+ loop (seq [e, str " "], test,
+ thenn, elsee)
+ | _ => layoutStatementIn (s, e, NONE)
+ end]
+ end
+ in
+ loop (str "", test, thenn, elsee)
+ end
+ | Labeled (id, s) =>
+ align [seq [Id.layout id, str ":"],
+ layoutStatement s]
+ | Return eo =>
+ seq [str "return",
+ case eo of
+ NONE => empty
+ | SOME e => seq [str " ", layoutExp e],
+ str ";"]
+ | Switch {clauses, test} =>
+ align [seq [str "switch ", paren (layoutExp test), str " {"],
+ align (Vector.toListMap
+ (clauses, fn (eo, ss) =>
+ align [case eo of
+ NONE => str "default:"
+ | SOME e => seq [str "case ",
+ layoutExp e, str ":"],
+ indent (layoutStatements ss, 2)])),
+ str "}"]
+ | Throw e => seq [str "throw ", layoutExp e, str ";"]
+ | Try {body, catch, finally} =>
+ align [str "try {",
+ indent (layoutStatements body, 2),
+ case catch of
+ NONE => empty
+ | SOME (id, ss) =>
+ align
+ [seq [str "} catch ", paren (Id.layout id),
+ str " {"],
+ indent (layoutStatements ss, 2)],
+ case finally of
+ NONE => empty
+ | SOME ss =>
+ align [str "} finally {",
+ indent (layoutStatements ss, 2)],
+ str "}"]
+ | Var ds =>
+ seq [str "var ",
+ commaList (ds, layoutVariableDeclaration),
+ str ";"]
+ | While {body, test} =>
+ layoutStatementIn
+ (body, seq [str "while ", paren (layoutExp test)], NONE)
+ | With {body, object} =>
+ layoutStatementIn
+ (body, seq [str "with ", paren (layoutExp object)], NONE)
+ and layoutStatements ss =
+ align (Vector.toListMap (ss, layoutStatement))
+
+ and layoutUnaryExp (e, {isStatement}) =
+ let
+ fun loop (e, {isStatement, lastOp}) =
+ let
+ fun done () =
+ seq [case lastOp of
+ NONE => empty
+ | SOME oper =>
+ if UnaryOp.isSymbolic oper
+ then empty
+ else str " ",
+ layoutPostfixExp (e, {isStatement = isStatement})]
+ in
+ case e of
+ Unary {exp, oper} =>
+ if UnaryOp.isPrefix oper
+ then seq [(case lastOp of
+ NONE => empty
+ | SOME oper' =>
+ if UnaryOp.mustSeparate
+ (oper', oper)
+ then str " "
+ else empty),
+ UnaryOp.layout oper,
+ loop (exp, {isStatement = false,
+ lastOp = SOME oper})]
+ else done ()
+ | _ => done ()
+ end
+ in
+ loop (e, {isStatement = isStatement, lastOp = NONE})
+ end
+
+ and layoutVariableDeclaration z =
+ layoutVariableDeclarationGen (z, {mayHaveIn = true})
+
+ and layoutVariableDeclarationNoIn z =
+ layoutVariableDeclarationGen (z, {mayHaveIn = false})
+
+ and layoutVariableDeclarationGen ((id, eo), {mayHaveIn}) =
+ seq [Id.layout id,
+ case eo of
+ NONE => empty
+ | SOME e => seq [str " = ",
+ layoutAssignmentExpGen
+ (e, {isStatement = false,
+ mayHaveIn = mayHaveIn})]]
+ end
+ end
+
+structure Exp =
+ struct
+ open Exp
+
+ val layout = Joint.layoutExp
+
+ val toString = Layout.toString o layout
+
+ val int = Number o Number.fromInt
+
+ fun word w = Number (Number.fromReal (Real.fromIntInf (Word.toIntInf w)))
+
+ val string = String o String.fromString
+
+ fun seq es =
+ if 1 = Vector.length es
+ then Vector.sub (es, 0)
+ else Seq es
+
+ val falsee = Bool false
+ val truee = Bool true
+
+ fun object v = Object (Vector.map (v, ObjectInit.Property))
+
+ fun select {object: t, property: t}: t =
+ let
+ fun simple () = Select {object = object, property = property}
+ in
+ case property of
+ String s =>
+ if String.isValidIdentifier s
+ then (SelectId
+ {object = object,
+ property = Id.fromString (String.toString s)})
+ else simple ()
+ | _ => simple ()
+ end
+
+ val isBool = fn Bool _ => true | _ => false
+
+ val isFalse = fn Bool true => true | _ => false
+
+ val isTrue = fn Bool true => true | _ => false
+
+ fun array (n: t): t =
+ New {args = Vector.new1 n,
+ object = Id (Id.fromString "Array")}
+
+ fun not e =
+ let
+ datatype z = datatype UnaryOp.t
+ fun keep () = Unary {exp = e, oper = LogicalNot}
+ in
+ case e of
+ Binary {lhs, oper, rhs} =>
+ let
+ datatype z = datatype BinaryOp.t
+ fun make oper = Binary {lhs = lhs, oper = oper, rhs = rhs}
+ in
+ case oper of
+ Equals => make NotEquals
+ | GreaterThan => make LessThanEqual
+ | GreaterThanEqual => make LessThan
+ | LessThan => make GreaterThanEqual
+ | LessThanEqual => make GreaterThan
+ | NotEquals => make Equals
+ | StrictEquals => make StrictNotEquals
+ | StrictNotEquals => make StrictEquals
+ | _ => keep ()
+ end
+ | Unary {exp, oper} =>
+ (case oper of
+ LogicalNot => exp
+ | _ => keep ())
+ | _ => keep ()
+ end
+ end
+
+structure Joint =
+ struct
+ open Joint
+
+ fun simplifyExps es = Vector.map (es, simplifyExp)
+ and simplifyExpOpt eo = Option.map (eo, simplifyExp)
+ and simplifyExp (e: exp): exp =
+ case e of
+ Array eos => Array (Vector.map (eos, simplifyExpOpt))
+ | Assign {lhs, oper, rhs} =>
+ Assign {lhs = simplifyExp lhs,
+ oper = oper,
+ rhs = simplifyExp rhs}
+ | Bool _ => e
+ | Binary {lhs, oper, rhs} =>
+ let
+ val lhs = simplifyExp lhs
+ val rhs = simplifyExp rhs
+ fun keep () = Binary {lhs = lhs, oper = oper, rhs = rhs}
+ datatype z = datatype BinaryOp.t
+ in
+ case oper of
+ Equals =>
+ (case (lhs, rhs) of
+ (Number n, _) =>
+ if Number.isZero n then Exp.not rhs else keep ()
+ | (_, Number n) =>
+ if Number.isZero n then Exp.not lhs else keep ()
+ | _ => keep ())
+ | NotEquals =>
+ (case (lhs, rhs) of
+ (Number n, _) =>
+ if Number.isZero n then rhs else keep ()
+ | (_, Number n) =>
+ if Number.isZero n then lhs else keep ()
+ | _ => keep ())
+ | _ => keep ()
+ end
+ | Call {args, func} => Call {args = simplifyExps args,
+ func = simplifyExp func}
+ | Cond {elsee, test, thenn} =>
+ Cond {elsee = simplifyExp elsee,
+ test = simplifyExp test,
+ thenn = simplifyExp thenn}
+ | Function {args, body, name} =>
+ Function {args = args,
+ body = simplifyStatements body,
+ name = name}
+ | Id _ => e
+ | New {args, object} =>
+ New {args = simplifyExps args, object = simplifyExp object}
+ | Number _ => e
+ | Null => e
+ | Object ois =>
+ Object (Vector.map
+ (ois, fn oi =>
+ let
+ datatype z = datatype ObjectInit.t
+ in
+ case oi of
+ Get _ => oi
+ | Property {property, value} =>
+ Property {property = property,
+ value = simplifyExp value}
+ | Set _ => oi
+ end))
+ | Regexp _ => e
+ | Seq es => Seq (Vector.map (es, simplifyExp))
+ | Select {object, property} =>
+ Select {object = simplifyExp object,
+ property = simplifyExp property}
+ | SelectId {object, property} =>
+ SelectId {object = simplifyExp object,
+ property = property}
+ | String _ => e
+ | Unary {exp, oper} =>
+ let
+ val exp = simplifyExp exp
+ datatype z = datatype UnaryOp.t
+ in
+ case oper of
+ LogicalNot => Exp.not exp
+ | _ => Unary {exp = exp, oper = oper}
+ end
+ | This => e
+ and simplifyStatements ss = Vector.map (ss, simplifyStatement)
+ and simplifyStatementOpt so = Option.map (so, simplifyStatement)
+ and simplifyStatement (s: statement): statement =
+ case s of
+ Block ss => Block (simplifyStatements ss)
+ | Break _ => s
+ | Const ies =>
+ Const (Vector.map (ies, fn (i, e) => (i, simplifyExp e)))
+ | Continue _ => s
+ | Do {body, test} => Do {body = simplifyStatement body,
+ test = simplifyExp test}
+ | Empty => s
+ | Exp e => Exp (simplifyExp e)
+ | For {body, inc, init, test} =>
+ For {body = simplifyStatement body,
+ inc = simplifyExpOpt inc,
+ init = simplifyExpOpt init,
+ test = simplifyExpOpt test}
+ | ForIn {body, lhs, object} =>
+ ForIn {body = simplifyStatement body,
+ lhs = simplifyExp lhs,
+ object = simplifyExp object}
+ | ForVar {body, inc, init, test} =>
+ ForVar {body = simplifyStatement body,
+ inc = simplifyExpOpt inc,
+ init = Vector.map (init, fn (i, eo) =>
+ (i, simplifyExpOpt eo)),
+ test = simplifyExpOpt test}
+ | ForVarIn {body, id, init, object} =>
+ ForVarIn {body = simplifyStatement body,
+ id = id,
+ init = simplifyExpOpt init,
+ object = simplifyExp object}
+ | FunctionDec {args, body, name} =>
+ FunctionDec {args = args,
+ body = Vector.map (body, simplifyStatement),
+ name = name}
+ | If {elsee, test, thenn} =>
+ let
+ val elsee = simplifyStatementOpt elsee
+ val test = simplifyExp test
+ val thenn = simplifyStatement thenn
+ in
+ case (test, elsee) of
+ (Unary {exp, oper = UnaryOp.LogicalNot}, SOME elsee) =>
+ If {elsee = SOME thenn,
+ test = exp,
+ thenn = elsee}
+ | _ => If {elsee = elsee, test = test, thenn = thenn}
+ end
+ | Labeled (id, s) =>
+ Labeled (id, simplifyStatement s)
+ | Return eo =>
+ Return (simplifyExpOpt eo)
+ | Switch {clauses, test} =>
+ Switch {clauses = Vector.map (clauses, fn (eo, ss) =>
+ (simplifyExpOpt eo,
+ simplifyStatements ss)),
+ test = simplifyExp test}
+ | Throw e => Throw (simplifyExp e)
+ | Try {body, catch, finally} =>
+ Try {body = simplifyStatements body,
+ catch = Option.map (catch, fn (i, ss) =>
+ (i, simplifyStatements ss)),
+ finally = Option.map (finally, simplifyStatements)}
+ | Var ies =>
+ Var (Vector.map (ies, fn (i, eo) => (i, simplifyExpOpt eo)))
+ | While {body, test} =>
+ While {body = simplifyStatement body,
+ test = simplifyExp test}
+ | With {body, object} =>
+ With {body = simplifyStatement body,
+ object = simplifyExp object}
+ end
+
+
+structure ObjectInit =
+ struct
+ datatype t = datatype Joint.objectInit
+ end
+
+structure Statement =
+ struct
+ open Statement
+
+ val layout = Joint.layoutStatement
+
+ fun scope (s: t vector): t =
+ Exp (Exp.Call {args = Vector.new0 (),
+ func = Exp.Function {args = Vector.new0 (),
+ body = s,
+ name = NONE}})
+ end
+
+structure Program =
+ struct
+ datatype t = T of Statement.t vector
+
+ fun layout (T ss) = Joint.layoutStatements ss
+
+ fun layouts (T ss, lay) = Vector.foreach (ss, lay o Statement.layout)
+
+ fun simplify (T ss) = T (Joint.simplifyStatements ss)
+ end
+
+end
Added: mltonlib/trunk/com/entain/javascript/unstable/javascript.grm
===================================================================
--- mltonlib/trunk/com/entain/javascript/unstable/javascript.grm 2006-10-29 18:53:30 UTC (rev 4796)
+++ mltonlib/trunk/com/entain/javascript/unstable/javascript.grm 2006-10-30 22:20:10 UTC (rev 4797)
@@ -0,0 +1,650 @@
+(* Copyright (C) 2006 Entain, Inc.
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+%%
+
+%eop EOF
+%header (functor Parser (structure Token: TOKEN))
+%keyword BREAK CASE CATCH CONTINUE DEFAULT DELETE DO ELSE FINALLY FOR
+ FUNCTION IF IN INSTANCE_OF NEW RETURN SWITCH THIS THROW TRY TYPEOF VAR
+ VOID WHILE WITH
+%name JAVASCRIPT
+%noshift EOF
+%pos SourcePos.t
+%start Program
+%verbose
+
+%term
+ ADDOP of string
+ | ASSIGNOP of string
+ | BANG
+ | BITOP of string
+ | BOOLEAN of string
+ | BREAK
+ | CASE
+ | CATCH
+ | COLON
+ | COMMA
+ | CONTINUE
+ | DEFAULT
+ | DELETE
+ | DO
+ | DOT
+ | ELSE
+ | EOF
+ | EQUALOP of string
+ | EQUALS
+ | FINALLY
+ | FOR
+ | FUNCTION
+ | IDENTIFIER of string
+ | IF
+ | IN
+ | INCOP of string
+ | INSTANCE_OF
+ | LBRACE
+ | LBRACKET
+ | LINE
+ | LOGICOP of string
+ | LPAREN
+ | MULOP of string
+ | NEW
+ | NULL
+ | NUMBER of string
+ | QUESTION
+ | RBRACE
+ | RBRACKET
+ | REGEXP of {body: string, caseSensitive: bool, global: bool}
+ | RELOP of string
+ | RETURN
+ | RPAREN
+ | SEMICOLON
+ | SHIFTOP of string
+ | STRING of string
+ | SWITCH
+ | THIS
+ | THROW
+ | TILDE
+ | TRY
+ | TYPEOF
+ | VAR
+ | VOID
+ | WHILE
+ | WITH
+
+%nonterm
+ AssignOpL
+ | CommaL
+ | DotL
+ | EqualsL
+ | LbraceL
+ | LbracketL
+ | LparenL
+ | RbraceL
+ | RbracketL
+ | RparenL
+ | InL
+ | QuestionL
+ | LogicalOrExpressionL
+ | UnaryExpressionL
+ | AssignmentExpressionNoInL
+ | ColonL
+ | ArgumentList
+ | ArgumentListL
+ | ArgumentListOpt
+ | ArgumentListOptL
+ | Arguments
+ | ArgumentsL
+ | ArrayLiteral
+ | AssignmentExpression
+ | AssignmentExpressionAS
+ | AssignmentExpressionL
+ | AssignmentExpressionNoIn
+ | AssignmentOperator
+ | AssignmentOperatorL
+ | Block
+ | BooleanLiteral
+ | CallExpression
+ | CallExpressionAS
+ | CallExpressionL
+ | CallExpressionRest
+ | CallExpressionRestL
+ | CaseBlock
+ | CaseClause
+ | CaseClauseOpt
+ | CaseClauses
+ | CaseClausesOpt
+ | Catch
+ | ConditionalExpression
+ | ConditionalExpressionAS
+ | ConditionalExpressionNoIn
+ | ConditionalExpressionL
+ | DefaultClause
+ | ElementList
+ | Elision
+ | ElisionOpt
+ | Expression
+ | ExpressionAS
+ | ExpressionL
+ | ExpressionNoIn
+ | ExpressionNoInOpt
+ | ExpressionOpt
+ | Finally
+ | FormalParameterList
+ | FormalParameterListOpt
+ | FunctionBody
+ | FunctionDeclaration
+ | FunctionExpression
+ | Identifier
+ | IdentifierL
+ | IdentifierOpt
+ | Initializer
+ | InitializerNoIn
+ | InitializerNoInOpt
+ | InitializerOpt
+ | LeftHandSideExpression
+ | LeftHandSideExpressionAS
+ | LeftHandSideExpressionL
+ | Literal
+ | Line
+ | LogicalOrExpression
+ | LogicalOrExpressionAS
+ | LogicalOrExpressionNoIn
+ | LogicalOrOp
+ | LogicalOrOpNoIn
+ | MemberExpression
+ | MemberExpressionAS
+ | MemberExpressionL
+ | NewExpression
+ | NewExpressionAS
+ | NewExpressionL
+ | News
+ | NullLiteral
+ | NumericLiteral
+ | ObjectLiteral
+ | OptionalSemi
+ | PostfixExpression
+ | PostfixExpressionAS
+ | PrimaryExpression
+ | PrimaryExpressionAS
+ | PropertyName
+ | PropertyNameAndValueList
+ | Program
+ | RegexpLiteral
+ | SourceElement
+ | SourceElementOS
+ | SourceElementsOS
+ | Statement
+ | Statement2
+ | StatementBeforeSemi
+ | StatementList
+ | StatementListOS (* Optional Semi *)
+ | StatementListOpt
+ | StatementListOptOS (* Optional Semi *)
+ | StatementOS (* Optional Semi *)
+ | StatementPrefix
+ | StringLiteral
+ | UnaryExpression
+ | UnaryExpressionAS
+ | UnaryOp
+ | VariableDeclaration
+ | VariableDeclarationList
+ | VariableDeclarationListNoIn
+ | VariableDeclarationNoIn
+
+%%
+
+ArgumentListL
+ : AssignmentExpressionL ()
+ | ArgumentListL CommaL AssignmentExpressionL ()
+
+ArgumentListOptL
+ : ()
+ | ArgumentListL ()
+
+Arguments
+ : LparenL ArgumentListOptL RPAREN ()
+
+ArgumentsL
+ : LparenL ArgumentListOptL RparenL ()
+
+ArrayLiteral
+ : LbracketL ElisionOpt RBRACKET ()
+ | LbracketL ElementList RBRACKET ()
+ | LbracketL ElementList COMMA ElisionOpt RBRACKET ()
+
+AssignmentExpression
+ : ConditionalExpression ()
+ | LeftHandSideExpression AssignmentOperatorL AssignmentExpression ()
+
+AssignmentExpressionL
+ : ConditionalExpressionL ()
+ | LeftHandSideExpressionL AssignmentOperatorL AssignmentExpressionL ()
+
+AssignmentExpressionAS
+ : ConditionalExpressionAS ()
+ | LeftHandSideExpressionAS AssignmentOperator AssignmentExpression ()
+
+AssignmentExpressionNoIn
+ : ConditionalExpressionNoIn ()
+ | LeftHandSideExpression AssignmentOperator AssignmentExpressionNoIn ()
+
+AssignmentOperator
+ : EQUALS ()
+ | ASSIGNOP ()
+
+AssignmentOperatorL
+ : EqualsL ()
+ | AssignOpL ()
+
+Block
+ : LbraceL StatementListOptOS RBRACE ()
+
+CallExpression
+ : MemberExpression Arguments CallExpressionRest ()
+
+CallExpressionAS
+ : MemberExpressionAS Arguments CallExpressionRest ()
+
+CallExpressionL
+ : MemberExpressionL ArgumentsL CallExpressionRestL ()
+
+CallExpressionRest
+ : ()
+ | CallExpressionRest Arguments ()
+ | CallExpressionRest LbracketL Expression RBRACKET ()
+ | CallExpressionRest DOT Identifier ()
+
+CallExpressionRestL
+ : ()
+ | CallExpressionRestL ArgumentsL ()
+ | CallExpressionRestL LbracketL ExpressionL RbracketL ()
+ | CallExpressionRestL DotL IdentifierL ()
+
+CaseBlock
+ : LbraceL CaseClausesOpt RBRACE ()
+ | LbraceL CaseClausesOpt DefaultClause CaseClausesOpt RBRACE ()
+
+CaseClause
+ : CASE Expression COLON StatementListOpt ()
+
+CaseClauses
+ : CaseClause ()
+ | CaseClauses CaseClause ()
+
+CaseClausesOpt
+ : ()
+ | CaseClauses ()
+
+Catch
+ : CATCH LparenL Identifier RPAREN Block ()
+
+ConditionalExpression
+ : LogicalOrExpression ()
+ | LogicalOrExpression QuestionL AssignmentExpressionL
+ ColonL AssignmentExpression ()
+
+ConditionalExpressionAS
+ : LogicalOrExpressionAS ()
+ | LogicalOrExpressionAS QuestionL AssignmentExpressionL
+ ColonL AssignmentExpression ()
+
+ConditionalExpressionL
+ : LogicalOrExpressionL ()
+ | LogicalOrExpressionL QuestionL AssignmentExpressionL
+ ColonL AssignmentExpressionL ()
+
+ConditionalExpressionNoIn
+ : LogicalOrExpressionNoIn ()
+ | LogicalOrExpressionNoIn QuestionL AssignmentExpressionNoInL
+ ColonL AssignmentExpressionNoIn ()
+
+DefaultClause
+ : DEFAULT COLON StatementList ()
+
+ElementList
+ : ElisionOpt AssignmentExpression ()
+ | ElementList COMMA ElisionOpt AssignmentExpression ()
+
+Elision
+ : COMMA ()
+ | Elision COMMA ()
+
+ElisionOpt
+ : ()
+ | Elision ()
+
+Expression
+ : AssignmentExpression ()
+ | Expression COMMA AssignmentExpression ()
+
+ExpressionL
+ : AssignmentExpressionL ()
+ | ExpressionL COMMA AssignmentExpressionL ()
+
+ExpressionAS
+ : AssignmentExpressionAS ()
+ | ExpressionAS COMMA AssignmentExpression ()
+
+ExpressionNoIn
+ : AssignmentExpressionNoIn ()
+ | ExpressionNoIn COMMA AssignmentExpressionNoIn ()
+
+ExpressionNoInOpt
+ : ()
+ | ExpressionNoIn ()
+
+ExpressionOpt
+ : ()
+ | Expression ()
+
+Finally
+ : FINALLY Block ()
+
+FormalParameterList
+ : Identifier ()
+ | FormalParameterList COMMA Identifier ()
+
+FormalParameterListOpt
+ : LparenL RPAREN ()
+ | LparenL FormalParameterList RPAREN ()
+
+FunctionBody
+ : LbraceL RBRACE ()
+ | LbraceL SourceElementsOS RBRACE ()
+
+FunctionDeclaration
+ : FUNCTION Identifier FormalParameterListOpt FunctionBody ()
+
+FunctionExpression
+ : FUNCTION IdentifierOpt FormalParameterListOpt FunctionBody ()
+
+Identifier
+ : IDENTIFIER ()
+
+IdentifierL
+ : IDENTIFIER Line ()
+
+IdentifierOpt
+ : ()
+ | Identifier ()
+
+Initializer
+ : EQUALS AssignmentExpression ()
+
+InitializerNoIn
+ : EQUALS AssignmentExpressionNoIn ()
+
+InitializerNoInOpt
+ : ()
+ | InitializerNoIn ()
+
+InitializerOpt
+ : ()
+ | Initializer ()
+
+LeftHandSideExpression
+ : NewExpression ()
+ | CallExpression ()
+
+LeftHandSideExpressionAS
+ : NewExpressionAS ()
+ | CallExpressionAS ()
+
+LeftHandSideExpressionL
+ : NewExpressionL ()
+ | CallExpressionL ()
+
+Literal
+ : BOOLEAN ()
+ | NullLiteral ()
+ | NumericLiteral ()
+ | RegexpLiteral ()
+ | StringLiteral ()
+
+LogicalOrExpression
+ : UnaryExpression ()
+ | UnaryExpression LogicalOrOp LogicalOrExpression ()
+
+LogicalOrExpressionAS
+ : UnaryExpressionAS ()
+ | UnaryExpressionAS LogicalOrOp LogicalOrExpression ()
+
+LogicalOrExpressionL
+ : UnaryExpressionL ()
+ | UnaryExpressionL LogicalOrOp Line LogicalOrExpressionL ()
+
+LogicalOrExpressionNoIn
+ : UnaryExpression ()
+ | UnaryExpression LogicalOrOpNoIn LogicalOrExpressionNoIn ()
+
+LogicalOrOp
+ : LogicalOrOpNoIn ()
+ | IN ()
+
+LogicalOrOpNoIn
+ : ADDOP ()
+ | BITOP ()
+ | EQUALOP ()
+ | INSTANCE_OF ()
+ | LOGICOP ()
+ | MULOP ()
+ | RELOP ()
+ | SHIFTOP ()
+
+MemberExpression
+ : PrimaryExpression ()
+ | FunctionExpression ()
+ | MemberExpression LbracketL ExpressionL RBRACKET ()
+ | MemberExpression DotL Identifier ()
+ | NewL MemberExpression Arguments ()
+
+MemberExpressionAS
+ : PrimaryExpressionAS ()
+ | FUNCTION FormalParameterListOpt FunctionBody ()
+ | MemberExpressionAS LbracketL Expression RBRACKET ()
+ | MemberExpressionAS DOT Identifier ()
+ | NEW MemberExpressionAS Arguments ()
+
+MemberExpressionL
+ : PrimaryExpressionL ()
+ | FunctionExpressionL ()
+ | MemberExpressionL LbracketL ExpressionL RbracketL ()
+ | MemberExpressionL DotL IdentifierL ()
+ | NewL MemberExpressionL ArgumentsL ()
+
+NewExpression
+ : MemberExpression ()
+ | NEW NewExpression ()
+
+NewExpressionAS
+ : MemberExpressionAS ()
+ | NEW NewExpressionAS ()
+
+NewExpressionL
+ : MemberExpressionL ()
+ | NewL NewExpressionL ()
+
+NullLiteral
+ : NULL ()
+
+NumericLiteral
+ : NUMBER ()
+
+ObjectLiteral
+ : LbraceL RBRACE ()
+ | LbraceL PropertyNameAndValueList RBRACE ()
+
+OptionalSemi
+ : ()
+ | SEMICOLON ()
+
+PostfixExpression
+ : LeftHandSideExpression ()
+ | LeftHandSideExpression INCOP ()
+
+PostfixExpressionAS
+ : LeftHandSideExpressionAS ()
+ | LeftHandSideExpressionAS INCOP ()
+
+PostfixExpressionL
+ : LeftHandSideExpressionL ()
+ | LeftHandSideExpression INCOP ()
+
+PrimaryExpression
+ : ObjectLiteral ()
+ | PrimaryExpressionAS ()
+
+PrimaryExpressionAS
+ : THIS ()
+ | Identifier ()
+ | Literal ()
+ | ArrayLiteral ()
+ | LparenL Expression RPAREN ()
+
+Program
+ : SourceElementsOS ()
+
+PropertyName
+ : Identifier ()
+ | StringLiteral ()
+ | NumericLiteral ()
+
+PropertyNameAndValueList
+ : PropertyName COLON AssignmentExpression ()
+ | PropertyNameAndValueList COMMA PropertyName COLON AssignmentExpression ()
+
+RegexpLiteral
+ : REGEXP ()
+
+SourceElement
+ : Statement ()
+ | FunctionDeclaration ()
+
+SourceElementOS
+ : StatementOS ()
+ | FunctionDeclaration ()
+
+SourceElementsOS
+ : SourceElementOS ()
+ | SourceElement SourceElementsOS ()
+
+Statement
+ : SEMICOLON ()
+ | Statement2 ()
+ | StatementPrefix Statement ()
+ | StatementBeforeSemi SEMICOLON ()
+ | Stat
More information about the MLton-commit
mailing list