branch

git-svn-id: svn://10.0.0.236/branches/IMGLIB2_NEWSTUFF@91714 18797224-902f-48f8-a5cc-f745e15eee43

mozilla/js2/AUTHORS

@@ -1 +0,0 @@
-

mozilla/js2/COPYING

@@ -1,29 +0,0 @@
-The contents of this file are subject to the Netscape Public
-License Version 1.1 (the "License"); you may not use this file
-except in compliance with the License. You may obtain a copy of
-the License at http://www.mozilla.org/NPL/
-
-Software distributed under the License is distributed on an "AS
-IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
-implied. See the License for the specific language governing
-rights and limitations under the License.
-
-The Original Code is the JavaScript 2 Prototype.
-
-The Initial Developer of the Original Code is Netscape
-Communications Corporation.  Portions created by Netscape are
-Copyright (C) 1998 Netscape Communications Corporation. All
-Rights Reserved.
-
-Alternatively, the contents of this file may be used under the
-terms of the GNU Public License (the "GPL"), in which case the
-provisions of the GPL are applicable instead of those above.
-If you wish to allow use of your version of this file only
-under the terms of the GPL and not to allow others to use your
-version of this file under the NPL, indicate your decision by
-deleting the provisions above and replace them with the notice
-and other provisions required by the GPL.  If you do not delete
-the provisions above, a recipient may use your version of this
-file under either the NPL or the GPL.
-
-

mozilla/js2/ChangeLog

@@ -1,14 +0,0 @@
-2001-01-30    <rginda@netscape.com>
-
-	* broke apart some classes contained parser.* and utilities.* into
-	  seperate files.
-	  parser.* begat lexer.*, token.*, reader.*
-	  utilities.* begat mem.*, stlcfg.h, ds.h, strings.*, exception.*,
-	  formatter.*, and algo.h
-	* parser reorg compile time data:
-
-	  new layout: 0:48.01elapsed 86%CPU
-	  old layout: 0:55.85elapsed 57%CPU
-
-	  (old layout includes only hash numerics utilities parser world object
-	  files)

mozilla/js2/INSTALL

@@ -1 +0,0 @@
-

mozilla/js2/Makefile.am

@@ -1,2 +0,0 @@
-
-SUBDIRS = src tests

mozilla/js2/NEWS

@@ -1 +0,0 @@
-

mozilla/js2/README

@@ -1,98 +0,0 @@
-parse functions
-    parseIdentifierQualifiers(ExprNode *e, bool &foundQualifiers,
-    parseParenthesesAndIdentifierQualifiers(const Token &tParen,
-    parseQualifiedIdentifier(const Token &t, bool preferRegExp)
-    parseArrayLiteral(const Token &initialToken)
-    parseObjectLiteral(const Token &initialToken)
-    parsePrimaryExpression()
-    parseMember(ExprNode *target, const Token &tOperator,
-    parseInvoke(ExprNode *target, uint32 pos,
-    parsePostfixExpression(bool newExpression)
-    parseUnaryExpression()
-    parseExpression(bool noIn, bool noAssignment, bool noComma)
-    parseParenthesizedExpression()
-    parseTypeExpression(bool noIn)
-    parseTypedIdentifier(ExprNode *&type)
-    parseTypeBinding(Token::Kind kind, bool noIn)
-    parseTypeListBinding(Token::Kind kind)
-    parseVariableBinding(bool noQualifiers, bool noIn)
-    parseFunctionName(FunctionName &fn)
-    parseFunctionSignature(FunctionDefinition &fd)
-    parseBlock(bool inSwitch, bool noCloseBrace)
-    parseBody(SemicolonState *semicolonState)
-    parseAttributeStatement(uint32 pos, IdentifierList *attributes,
-    parseAttributesAndStatement(const Token *t, AttributeStatement as,
-    parseAnnotatedBlock()
-    parseFor(uint32 pos, SemicolonState &semicolonState)
-    parseTry(uint32 pos)
-    parseStatement(bool /*topLevel*/, bool inSwitch,
-    parseStatementAndSemicolon(SemicolonState &semicolonState)
-    parseIdentifier()
-    parseLiteralField()
-    parseFieldName()
-    parseArgumentList(NodeQueue<ExprPairList> &args)
-    parseArgumentListPrime(NodeQueue<ExprPairList> &args)
-    parseNamedArgumentListPrime(NodeQueue<ExprPairList> &args)
-    parseAllParameters(FunctionDefinition &fd,
-    parseOptionalNamedRestParameters (FunctionDefinition &fd,
-    parseNamedRestParameters(FunctionDefinition &fd,
-    parseNamedParameters(FunctionDefinition &fd,
-    parseRestParameter()
-    parseParameter()
-    parseOptionalParameter()
-    parseOptionalParameterPrime(VariableBinding *first)
-    parseNamedParameter(NodeQueue<IdentifierList> &aliases)
-    parseResultSignature()
-
-
-1/28/01
-
-Files:
-
-cpucfg.h
-
-formatter.cpp formatter.h
-"Formatter" class, iostream like wrapper around stdio.
-
-gc_allocator.h, gc_container.h
-boehm gc stuff.
-
-hash.cpp hash.h
-a hash
-
-lexer.cpp lexer.h
-main lexer.
-
-mem.cpp mem.h
-zone, arena, and pool classes for memory management.
-
-nodefactory.h
-parse node factory.
-
-numerics.cpp numerics.h
-numbers and stuff.
-
-parser.cpp parser.h
-main parser source.
-tables in parser.h: 
-    enum ExprNode::Kind; types of expressions
-    enum StmtNode::Kind; types of statements
-
-
-reader.cpp reader.h
-"Reader" class, feeds source to the parser/lexer.
-
-stlcfg.h
-stupid stl tricks
-.
-systemtypes.h
-basic typedefs.
-
-token.cpp token.h
-token class.
-
-utilities.cpp utilities.h
-random things.
-
-world.cpp world.h
-the whole world.

mozilla/js2/TODO

@@ -1,26 +0,0 @@
-redo parseAllPArameters code
-
-
-move js/js2 to js2/src
-move js/semantics to js2/semantics
-
-compile on mac and windows
-
-parser:
-
-1. Parser is out of date (by 10%?)
-    a. rework parser to reflect grammer productions.
-    b. functional attrs.
-    c. parser node struct changes.
-
-2. Parser Restructuring (2 weeks.)
-
-3. Common lisp generator running?
-
-4. const-ness
-    a. compile time detection.
-    b. read before assign.
-    c. runtime assignment prevention.
-    d. class/ function/ const equivalence.
-
-export, namespace, import, package ?

mozilla/js2/aclocal.m4

@@ -1,140 +0,0 @@
-dnl aclocal.m4 generated automatically by aclocal 1.4
-
-dnl Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-dnl This program is distributed in the hope that it will be useful,
-dnl but WITHOUT ANY WARRANTY, to the extent permitted by law; without
-dnl even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-dnl PARTICULAR PURPOSE.
-
-# Do all the work for Automake.  This macro actually does too much --
-# some checks are only needed if your package does certain things.
-# But this isn't really a big deal.
-
-# serial 1
-
-dnl Usage:
-dnl AM_INIT_AUTOMAKE(package,version, [no-define])
-
-AC_DEFUN(AM_INIT_AUTOMAKE,
-[AC_REQUIRE([AC_PROG_INSTALL])
-PACKAGE=[$1]
-AC_SUBST(PACKAGE)
-VERSION=[$2]
-AC_SUBST(VERSION)
-dnl test to see if srcdir already configured
-if test "`cd $srcdir && pwd`" != "`pwd`" && test -f $srcdir/config.status; then
-  AC_MSG_ERROR([source directory already configured; run "make distclean" there first])
-fi
-ifelse([$3],,
-AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE", [Name of package])
-AC_DEFINE_UNQUOTED(VERSION, "$VERSION", [Version number of package]))
-AC_REQUIRE([AM_SANITY_CHECK])
-AC_REQUIRE([AC_ARG_PROGRAM])
-dnl FIXME This is truly gross.
-missing_dir=`cd $ac_aux_dir && pwd`
-AM_MISSING_PROG(ACLOCAL, aclocal, $missing_dir)
-AM_MISSING_PROG(AUTOCONF, autoconf, $missing_dir)
-AM_MISSING_PROG(AUTOMAKE, automake, $missing_dir)
-AM_MISSING_PROG(AUTOHEADER, autoheader, $missing_dir)
-AM_MISSING_PROG(MAKEINFO, makeinfo, $missing_dir)
-AC_REQUIRE([AC_PROG_MAKE_SET])])
-
-#
-# Check to make sure that the build environment is sane.
-#
-
-AC_DEFUN(AM_SANITY_CHECK,
-[AC_MSG_CHECKING([whether build environment is sane])
-# Just in case
-sleep 1
-echo timestamp > conftestfile
-# Do `set' in a subshell so we don't clobber the current shell's
-# arguments.  Must try -L first in case configure is actually a
-# symlink; some systems play weird games with the mod time of symlinks
-# (eg FreeBSD returns the mod time of the symlink's containing
-# directory).
-if (
-   set X `ls -Lt $srcdir/configure conftestfile 2> /dev/null`
-   if test "[$]*" = "X"; then
-      # -L didn't work.
-      set X `ls -t $srcdir/configure conftestfile`
-   fi
-   if test "[$]*" != "X $srcdir/configure conftestfile" \
-      && test "[$]*" != "X conftestfile $srcdir/configure"; then
-
-      # If neither matched, then we have a broken ls.  This can happen
-      # if, for instance, CONFIG_SHELL is bash and it inherits a
-      # broken ls alias from the environment.  This has actually
-      # happened.  Such a system could not be considered "sane".
-      AC_MSG_ERROR([ls -t appears to fail.  Make sure there is not a broken
-alias in your environment])
-   fi
-
-   test "[$]2" = conftestfile
-   )
-then
-   # Ok.
-   :
-else
-   AC_MSG_ERROR([newly created file is older than distributed files!
-Check your system clock])
-fi
-rm -f conftest*
-AC_MSG_RESULT(yes)])
-
-dnl AM_MISSING_PROG(NAME, PROGRAM, DIRECTORY)
-dnl The program must properly implement --version.
-AC_DEFUN(AM_MISSING_PROG,
-[AC_MSG_CHECKING(for working $2)
-# Run test in a subshell; some versions of sh will print an error if
-# an executable is not found, even if stderr is redirected.
-# Redirect stdin to placate older versions of autoconf.  Sigh.
-if ($2 --version) < /dev/null > /dev/null 2>&1; then
-   $1=$2
-   AC_MSG_RESULT(found)
-else
-   $1="$3/missing $2"
-   AC_MSG_RESULT(missing)
-fi
-AC_SUBST($1)])
-
-# Define a conditional.
-
-AC_DEFUN(AM_CONDITIONAL,
-[AC_SUBST($1_TRUE)
-AC_SUBST($1_FALSE)
-if $2; then
-  $1_TRUE=
-  $1_FALSE='#'
-else
-  $1_TRUE='#'
-  $1_FALSE=
-fi])
-
-# Like AC_CONFIG_HEADER, but automatically create stamp file.
-
-AC_DEFUN(AM_CONFIG_HEADER,
-[AC_PREREQ([2.12])
-AC_CONFIG_HEADER([$1])
-dnl When config.status generates a header, we must update the stamp-h file.
-dnl This file resides in the same directory as the config header
-dnl that is generated.  We must strip everything past the first ":",
-dnl and everything past the last "/".
-AC_OUTPUT_COMMANDS(changequote(<<,>>)dnl
-ifelse(patsubst(<<$1>>, <<[^ ]>>, <<>>), <<>>,
-<<test -z "<<$>>CONFIG_HEADERS" || echo timestamp > patsubst(<<$1>>, <<^\([^:]*/\)?.*>>, <<\1>>)stamp-h<<>>dnl>>,
-<<am_indx=1
-for am_file in <<$1>>; do
-  case " <<$>>CONFIG_HEADERS " in
-  *" <<$>>am_file "*<<)>>
-    echo timestamp > `echo <<$>>am_file | sed -e 's%:.*%%' -e 's%[^/]*$%%'`stamp-h$am_indx
-    ;;
-  esac
-  am_indx=`expr "<<$>>am_indx" + 1`
-done<<>>dnl>>)
-changequote([,]))])
-

mozilla/js2/common.mk

@@ -1,20 +0,0 @@
-
-BOEHM_DIR = $(top_srcdir)/../gc/boehm/
-LIBBOEHM = $(BOEHM_DIR)/gc.a
-
-JS2_DIR = $(top_srcdir)/src/
-LIBJS2 = $(JS2_DIR)/libjs2.a
-
-WFLAGS = -Wmissing-prototypes -Wstrict-prototypes -Wunused \
-         -Wswitch -Wall -Wconversion
-
-if DEBUG
-CXXFLAGS = -DXP_UNIX -g -DDEBUG $(WFLAGS)
-JS1x_BINDIR = Linux_All_DBG.OBJ
-else
-CXXFLAGS = -DXP_UNIX -O2 -Wuninitialized $(WFLAGS)
-JS1x_BINDIR = Linux_All_OPT.OBJ
-endif
-
-FDLIBM_DIR = $(top_srcdir)/../js/src/fdlibm/$(JS1x_BINDIR)
-LIBFDLIBM = $(FDLIBM_DIR)/libfdm.a

mozilla/js2/config.h.in

@@ -1,42 +0,0 @@
-/* config.h.in.  Generated automatically from configure.in by autoheader.  */
-
-/* Define if using alloca.c.  */
-#undef C_ALLOCA
-
-/* Define to one of _getb67, GETB67, getb67 for Cray-2 and Cray-YMP systems.
-   This function is required for alloca.c support on those systems.  */
-#undef CRAY_STACKSEG_END
-
-/* Define if you have alloca, as a function or macro.  */
-#undef HAVE_ALLOCA
-
-/* Define if you have <alloca.h> and it should be used (not on Ultrix).  */
-#undef HAVE_ALLOCA_H
-
-/* Define if you have a working `mmap' system call.  */
-#undef HAVE_MMAP
-
-/* If using the C implementation of alloca, define if you know the
-   direction of stack growth for your system; otherwise it will be
-   automatically deduced at run-time.
- STACK_DIRECTION > 0 => grows toward higher addresses
- STACK_DIRECTION < 0 => grows toward lower addresses
- STACK_DIRECTION = 0 => direction of growth unknown
- */
-#undef STACK_DIRECTION
-
-/* Define if you have the ANSI C header files.  */
-#undef STDC_HEADERS
-
-/* Define if you have the getpagesize function.  */
-#undef HAVE_GETPAGESIZE
-
-/* Define if you have the <unistd.h> header file.  */
-#undef HAVE_UNISTD_H
-
-/* Name of package */
-#undef PACKAGE
-
-/* Version number of package */
-#undef VERSION
-

mozilla/js2/configure.in

@@ -1,57 +0,0 @@
-dnl Process this file with autoconf to produce a configure script.
-
-PACKAGE=JavaScript2
-VERSION=0.1
-AC_INIT(src/parser.h)
-AM_INIT_AUTOMAKE(JavaScript2, 0.1)
-
-AC_ARG_ENABLE(debug,
-[  --enable-debug    Turn on debugging],
-[case "${enableval}" in
-  yes) debug=true ;;
-  no)  debug=false ;;
-  *) AC_MSG_ERROR(bad value ${enableval} for --enable-debug) ;;
-esac],[debug=false])
-AM_CONDITIONAL(DEBUG, test x$debug = xtrue)
-
-AM_CONFIG_HEADER(config.h)
-dnl Checks for programs.
-AC_PROG_CXX
-AC_PROG_AWK
-AC_PROG_CC
-AC_PROG_INSTALL
-AC_PROG_LN_S
-AC_PROG_MAKE_SET
-AC_PROG_RANLIB
-dnl AM_PATH_GTK(1.2.0, ,
-dnl            AC_MSG_ERROR(Cannot find GTK: Is gtk-config in path?))
-
-dnl Checks for libraries.
-dnl Replace `main' with a function in -ldl:
-dnl AC_CHECK_LIB(dl, main)
-dnl Replace `main' with a function in -lgdk:
-dnl AC_CHECK_LIB(gdk, main)
-dnl Replace `main' with a function in -lglib:
-dnl AC_CHECK_LIB(glib, main)
-dnl Replace `main' with a function in -lgmodule:
-dnl AC_CHECK_LIB(gmodule, main)
-dnl Replace `main' with a function in -lgtk:
-dnl AC_CHECK_LIB(gtk, main)
-dnl Replace `main' with a function in -lm:
-dnl AC_CHECK_LIB(m, main)
-
-dnl Checks for header files.
-AC_HEADER_STDC
-dnl AC_CHECK_HEADERS(fcntl.h limits.h malloc.h strings.h unistd.h)
-
-dnl Checks for typedefs, structures, and compiler characteristics.
-dnl AC_C_CONST
-dnl AC_C_INLINE
-dnl AC_TYPE_SIZE_T
-
-dnl Checks for library functions.
-AC_FUNC_ALLOCA
-AC_FUNC_MMAP
-dnl AC_CHECK_FUNCS(getcwd getwd putenv strdup strerror tcgetattr)
-
-AC_OUTPUT(./Makefile src/Makefile tests/Makefile tests/cpp/Makefile tests/js/Makefile)

mozilla/js2/install-sh

@@ -1,251 +0,0 @@
-#!/bin/sh
-#
-# install - install a program, script, or datafile
-# This comes from X11R5 (mit/util/scripts/install.sh).
-#
-# Copyright 1991 by the Massachusetts Institute of Technology
-#
-# Permission to use, copy, modify, distribute, and sell this software and its
-# documentation for any purpose is hereby granted without fee, provided that
-# the above copyright notice appear in all copies and that both that
-# copyright notice and this permission notice appear in supporting
-# documentation, and that the name of M.I.T. not be used in advertising or
-# publicity pertaining to distribution of the software without specific,
-# written prior permission.  M.I.T. makes no representations about the
-# suitability of this software for any purpose.  It is provided "as is"
-# without express or implied warranty.
-#
-# Calling this script install-sh is preferred over install.sh, to prevent
-# `make' implicit rules from creating a file called install from it
-# when there is no Makefile.
-#
-# This script is compatible with the BSD install script, but was written
-# from scratch.  It can only install one file at a time, a restriction
-# shared with many OS's install programs.
-
-
-# set DOITPROG to echo to test this script
-
-# Don't use :- since 4.3BSD and earlier shells don't like it.
-doit="${DOITPROG-}"
-
-
-# put in absolute paths if you don't have them in your path; or use env. vars.
-
-mvprog="${MVPROG-mv}"
-cpprog="${CPPROG-cp}"
-chmodprog="${CHMODPROG-chmod}"
-chownprog="${CHOWNPROG-chown}"
-chgrpprog="${CHGRPPROG-chgrp}"
-stripprog="${STRIPPROG-strip}"
-rmprog="${RMPROG-rm}"
-mkdirprog="${MKDIRPROG-mkdir}"
-
-transformbasename=""
-transform_arg=""
-instcmd="$mvprog"
-chmodcmd="$chmodprog 0755"
-chowncmd=""
-chgrpcmd=""
-stripcmd=""
-rmcmd="$rmprog -f"
-mvcmd="$mvprog"
-src=""
-dst=""
-dir_arg=""
-
-while [ x"$1" != x ]; do
-    case $1 in
-	-c) instcmd="$cpprog"
-	    shift
-	    continue;;
-
-	-d) dir_arg=true
-	    shift
-	    continue;;
-
-	-m) chmodcmd="$chmodprog $2"
-	    shift
-	    shift
-	    continue;;
-
-	-o) chowncmd="$chownprog $2"
-	    shift
-	    shift
-	    continue;;
-
-	-g) chgrpcmd="$chgrpprog $2"
-	    shift
-	    shift
-	    continue;;
-
-	-s) stripcmd="$stripprog"
-	    shift
-	    continue;;
-
-	-t=*) transformarg=`echo $1 | sed 's/-t=//'`
-	    shift
-	    continue;;
-
-	-b=*) transformbasename=`echo $1 | sed 's/-b=//'`
-	    shift
-	    continue;;
-
-	*)  if [ x"$src" = x ]
-	    then
-		src=$1
-	    else
-		# this colon is to work around a 386BSD /bin/sh bug
-		:
-		dst=$1
-	    fi
-	    shift
-	    continue;;
-    esac
-done
-
-if [ x"$src" = x ]
-then
-	echo "install:	no input file specified"
-	exit 1
-else
-	true
-fi
-
-if [ x"$dir_arg" != x ]; then
-	dst=$src
-	src=""
-	
-	if [ -d $dst ]; then
-		instcmd=:
-		chmodcmd=""
-	else
-		instcmd=mkdir
-	fi
-else
-
-# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
-# might cause directories to be created, which would be especially bad 
-# if $src (and thus $dsttmp) contains '*'.
-
-	if [ -f $src -o -d $src ]
-	then
-		true
-	else
-		echo "install:  $src does not exist"
-		exit 1
-	fi
-	
-	if [ x"$dst" = x ]
-	then
-		echo "install:	no destination specified"
-		exit 1
-	else
-		true
-	fi
-
-# If destination is a directory, append the input filename; if your system
-# does not like double slashes in filenames, you may need to add some logic
-
-	if [ -d $dst ]
-	then
-		dst="$dst"/`basename $src`
-	else
-		true
-	fi
-fi
-
-## this sed command emulates the dirname command
-dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
-
-# Make sure that the destination directory exists.
-#  this part is taken from Noah Friedman's mkinstalldirs script
-
-# Skip lots of stat calls in the usual case.
-if [ ! -d "$dstdir" ]; then
-defaultIFS='	
-'
-IFS="${IFS-${defaultIFS}}"
-
-oIFS="${IFS}"
-# Some sh's can't handle IFS=/ for some reason.
-IFS='%'
-set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
-IFS="${oIFS}"
-
-pathcomp=''
-
-while [ $# -ne 0 ] ; do
-	pathcomp="${pathcomp}${1}"
-	shift
-
-	if [ ! -d "${pathcomp}" ] ;
-        then
-		$mkdirprog "${pathcomp}"
-	else
-		true
-	fi
-
-	pathcomp="${pathcomp}/"
-done
-fi
-
-if [ x"$dir_arg" != x ]
-then
-	$doit $instcmd $dst &&
-
-	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
-	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
-	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
-	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
-else
-
-# If we're going to rename the final executable, determine the name now.
-
-	if [ x"$transformarg" = x ] 
-	then
-		dstfile=`basename $dst`
-	else
-		dstfile=`basename $dst $transformbasename | 
-			sed $transformarg`$transformbasename
-	fi
-
-# don't allow the sed command to completely eliminate the filename
-
-	if [ x"$dstfile" = x ] 
-	then
-		dstfile=`basename $dst`
-	else
-		true
-	fi
-
-# Make a temp file name in the proper directory.
-
-	dsttmp=$dstdir/#inst.$$#
-
-# Move or copy the file name to the temp name
-
-	$doit $instcmd $src $dsttmp &&
-
-	trap "rm -f ${dsttmp}" 0 &&
-
-# and set any options; do chmod last to preserve setuid bits
-
-# If any of these fail, we abort the whole thing.  If we want to
-# ignore errors from any of these, just make sure not to ignore
-# errors from the above "$doit $instcmd $src $dsttmp" command.
-
-	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
-	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
-	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
-	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
-
-# Now rename the file to the real destination.
-
-	$doit $rmcmd -f $dstdir/$dstfile &&
-	$doit $mvcmd $dsttmp $dstdir/$dstfile 
-
-fi &&
-
-
-exit 0

mozilla/js2/missing

@@ -1,190 +0,0 @@
-#! /bin/sh
-# Common stub for a few missing GNU programs while installing.
-# Copyright (C) 1996, 1997 Free Software Foundation, Inc.
-# Franc,ois Pinard <pinard@iro.umontreal.ca>, 1996.
-
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-# 02111-1307, USA.
-
-if test $# -eq 0; then
-  echo 1>&2 "Try \`$0 --help' for more information"
-  exit 1
-fi
-
-case "$1" in
-
-  -h|--h|--he|--hel|--help)
-    echo "\
-$0 [OPTION]... PROGRAM [ARGUMENT]...
-
-Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an
-error status if there is no known handling for PROGRAM.
-
-Options:
-  -h, --help      display this help and exit
-  -v, --version   output version information and exit
-
-Supported PROGRAM values:
-  aclocal      touch file \`aclocal.m4'
-  autoconf     touch file \`configure'
-  autoheader   touch file \`config.h.in'
-  automake     touch all \`Makefile.in' files
-  bison        create \`y.tab.[ch]', if possible, from existing .[ch]
-  flex         create \`lex.yy.c', if possible, from existing .c
-  lex          create \`lex.yy.c', if possible, from existing .c
-  makeinfo     touch the output file
-  yacc         create \`y.tab.[ch]', if possible, from existing .[ch]"
-    ;;
-
-  -v|--v|--ve|--ver|--vers|--versi|--versio|--version)
-    echo "missing - GNU libit 0.0"
-    ;;
-
-  -*)
-    echo 1>&2 "$0: Unknown \`$1' option"
-    echo 1>&2 "Try \`$0 --help' for more information"
-    exit 1
-    ;;
-
-  aclocal)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified \`acinclude.m4' or \`configure.in'.  You might want
-         to install the \`Automake' and \`Perl' packages.  Grab them from
-         any GNU archive site."
-    touch aclocal.m4
-    ;;
-
-  autoconf)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified \`configure.in'.  You might want to install the
-         \`Autoconf' and \`GNU m4' packages.  Grab them from any GNU
-         archive site."
-    touch configure
-    ;;
-
-  autoheader)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified \`acconfig.h' or \`configure.in'.  You might want
-         to install the \`Autoconf' and \`GNU m4' packages.  Grab them
-         from any GNU archive site."
-    files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' configure.in`
-    test -z "$files" && files="config.h"
-    touch_files=
-    for f in $files; do
-      case "$f" in
-      *:*) touch_files="$touch_files "`echo "$f" |
-				       sed -e 's/^[^:]*://' -e 's/:.*//'`;;
-      *) touch_files="$touch_files $f.in";;
-      esac
-    done
-    touch $touch_files
-    ;;
-
-  automake)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified \`Makefile.am', \`acinclude.m4' or \`configure.in'.
-         You might want to install the \`Automake' and \`Perl' packages.
-         Grab them from any GNU archive site."
-    find . -type f -name Makefile.am -print |
-	   sed 's/\.am$/.in/' |
-	   while read f; do touch "$f"; done
-    ;;
-
-  bison|yacc)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified a \`.y' file.  You may need the \`Bison' package
-         in order for those modifications to take effect.  You can get
-         \`Bison' from any GNU archive site."
-    rm -f y.tab.c y.tab.h
-    if [ $# -ne 1 ]; then
-        eval LASTARG="\${$#}"
-	case "$LASTARG" in
-	*.y)
-	    SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'`
-	    if [ -f "$SRCFILE" ]; then
-	         cp "$SRCFILE" y.tab.c
-	    fi
-	    SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'`
-	    if [ -f "$SRCFILE" ]; then
-	         cp "$SRCFILE" y.tab.h
-	    fi
-	  ;;
-	esac
-    fi
-    if [ ! -f y.tab.h ]; then
-	echo >y.tab.h
-    fi
-    if [ ! -f y.tab.c ]; then
-	echo 'main() { return 0; }' >y.tab.c
-    fi
-    ;;
-
-  lex|flex)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified a \`.l' file.  You may need the \`Flex' package
-         in order for those modifications to take effect.  You can get
-         \`Flex' from any GNU archive site."
-    rm -f lex.yy.c
-    if [ $# -ne 1 ]; then
-        eval LASTARG="\${$#}"
-	case "$LASTARG" in
-	*.l)
-	    SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'`
-	    if [ -f "$SRCFILE" ]; then
-	         cp "$SRCFILE" lex.yy.c
-	    fi
-	  ;;
-	esac
-    fi
-    if [ ! -f lex.yy.c ]; then
-	echo 'main() { return 0; }' >lex.yy.c
-    fi
-    ;;
-
-  makeinfo)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified a \`.texi' or \`.texinfo' file, or any other file
-         indirectly affecting the aspect of the manual.  The spurious
-         call might also be the consequence of using a buggy \`make' (AIX,
-         DU, IRIX).  You might want to install the \`Texinfo' package or
-         the \`GNU make' package.  Grab either from any GNU archive site."
-    file=`echo "$*" | sed -n 's/.*-o \([^ ]*\).*/\1/p'`
-    if test -z "$file"; then
-      file=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'`
-      file=`sed -n '/^@setfilename/ { s/.* \([^ ]*\) *$/\1/; p; q; }' $file`
-    fi
-    touch $file
-    ;;
-
-  *)
-    echo 1>&2 "\
-WARNING: \`$1' is needed, and you do not seem to have it handy on your
-         system.  You might have modified some files without having the
-         proper tools for further handling them.  Check the \`README' file,
-         it often tells you about the needed prerequirements for installing
-         this package.  You may also peek at any GNU archive site, in case
-         some other package would contain this missing \`$1' program."
-    exit 1
-    ;;
-esac
-
-exit 0

mozilla/js2/mkinstalldirs

@@ -1,40 +0,0 @@
-#! /bin/sh
-# mkinstalldirs --- make directory hierarchy
-# Author: Noah Friedman <friedman@prep.ai.mit.edu>
-# Created: 1993-05-16
-# Public domain
-
-# $Id: mkinstalldirs,v 1.1 2001-02-07 21:20:46 rginda%netscape.com Exp $
-
-errstatus=0
-
-for file
-do
-   set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'`
-   shift
-
-   pathcomp=
-   for d
-   do
-     pathcomp="$pathcomp$d"
-     case "$pathcomp" in
-       -* ) pathcomp=./$pathcomp ;;
-     esac
-
-     if test ! -d "$pathcomp"; then
-        echo "mkdir $pathcomp"
-
-        mkdir "$pathcomp" || lasterr=$?
-
-        if test ! -d "$pathcomp"; then
-  	  errstatus=$lasterr
-        fi
-     fi
-
-     pathcomp="$pathcomp/"
-   done
-done
-
-exit $errstatus
-
-# mkinstalldirs ends here

mozilla/js2/semantics/GrammarSymbol.lisp

@@ -1,550 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; LALR(1) and LR(1) parametrized grammar utilities
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; UTILITIES
-
-(declaim (inline identifier?))
-(defun identifier? (form)
-  (and form (symbolp form) (not (keywordp form))))
-
-(deftype identifier () '(satisfies identifier?))
-
-
-; Make sure that form is one of the following:
-;   A symbol
-;   An integer
-;   A float
-;   A character
-;   A string
-;   A list of zero or more forms that also satisfy ensure-proper-form;
-;     the list cannot be dotted.
-; Return the form.
-(defun ensure-proper-form (form)
-  (labels
-    ((ensure-list-form (form)
-       (or (null form)
-           (and (consp form)
-                (progn
-                  (ensure-proper-form (car form))
-                  (ensure-list-form (cdr form)))))))
-    (unless
-      (or (symbolp form)
-          (integerp form)
-          (floatp form)
-          (characterp form)
-          (stringp form)
-          (ensure-list-form form))
-      (error "Bad form: ~S" form))
-    form))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; TERMINALS
-
-; A terminal is any of the following:
-;   A symbol that is neither nil nor a keyword
-;   A string;
-;   A character;
-;   An integer.
-(defun terminal? (x)
-  (and x
-       (or (and (symbolp x) (not (keywordp x)))
-           (stringp x)
-           (characterp x)
-           (integerp x))))
-
-; The following terminals are reserved and may not be used in user input:
-;   $$   Marker for end of token stream
-(defconstant *end-marker* '$$)
-(defconstant *end-marker-terminal-number* 0)
-
-(deftype terminal () '(satisfies terminal?))
-(deftype user-terminal () `(and terminal (not (eql ,*end-marker*))))
-
-
-; Emit markup for a terminal.  subscript is an optional integer.
-(defun depict-terminal (markup-stream terminal &optional subscript)
-  (cond
-   ((characterp terminal)
-    (depict-char-style (markup-stream ':character-literal)
-      (depict-character markup-stream terminal)
-      (when subscript
-        (depict-char-style (markup-stream ':plain-subscript)
-          (depict-integer markup-stream subscript)))))
-   ((and terminal (symbolp terminal))
-    (let ((name (symbol-name terminal)))
-      (if (and (> (length name) 0) (char= (char name 0) #\$))
-        (depict-char-style (markup-stream ':terminal)
-          (depict markup-stream (subseq (symbol-upper-mixed-case-name terminal) 1))
-          (when subscript
-            (depict-char-style (markup-stream ':plain-subscript)
-              (depict-integer markup-stream subscript))))
-        (progn
-          (depict-char-style (markup-stream ':terminal-keyword)
-            (depict markup-stream (string-downcase name)))
-          (when subscript
-            (depict-char-style (markup-stream ':terminal)
-              (depict-char-style (markup-stream ':plain-subscript)
-                (depict-integer markup-stream subscript))))))))
-   (t (error "Don't know how to emit markup for terminal ~S" terminal))))
-
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; NONTERMINAL PARAMETERS
-
-(declaim (inline nonterminal-parameter?))
-(defun nonterminal-parameter? (x)
-  (symbolp x))
-(deftype nonterminal-parameter () 'symbol)
-
-
-; Return true if this nonterminal parameter is a constant.
-(declaim (inline nonterminal-attribute?))
-(defun nonterminal-attribute? (parameter)
-  (and (symbolp parameter) (not (keywordp parameter))))
-(deftype nonterminal-attribute () '(and symbol (not keyword)))
-
-
-(defun depict-nonterminal-attribute (markup-stream attribute)
-  (depict-char-style (markup-stream ':nonterminal)
-    (depict-char-style (markup-stream ':nonterminal-attribute)
-      (depict markup-stream (symbol-lower-mixed-case-name attribute)))))
-
-
-; Return true if this nonterminal parameter is a variable.
-(declaim (inline nonterminal-argument?))
-(defun nonterminal-argument? (parameter)
-  (keywordp parameter))
-(deftype nonterminal-argument () 'keyword)
-
-
-(defparameter *special-nonterminal-arguments*
-  '(:alpha :beta :gamma :delta :epsilon :zeta :eta :theta :iota :kappa :lambda :mu :nu
-    :xi :omicron :pi :rho :sigma :tau :upsilon :phi :chi :psi :omega))
-
-(defun depict-nonterminal-argument-symbol (markup-stream argument)
-  (depict-char-style (markup-stream ':nonterminal-argument)
-    (let ((argument (symbol-abbreviation argument)))
-      (depict markup-stream
-              (if (member argument *special-nonterminal-arguments*)
-                argument
-                (symbol-upper-mixed-case-name argument))))))
-
-(defun depict-nonterminal-argument (markup-stream argument)
-  (depict-char-style (markup-stream ':nonterminal)
-    (depict-nonterminal-argument-symbol markup-stream argument)))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; ATTRIBUTED NONTERMINALS
-
-; An attributed-nonterminal is a specific instantiation of a generic-nonterminal.
-(defstruct (attributed-nonterminal (:constructor allocate-attributed-nonterminal (symbol attributes))
-                                   (:copier nil)
-                                   (:predicate attributed-nonterminal?))
-  (symbol nil :type keyword :read-only t)    ;The name of the attributed nonterminal
-  (attributes nil :type list :read-only t))  ;Ordered list of nonterminal attributes
-
-
-; Make an attributed nonterminal with the given symbol and attributes.  If there
-; are no attributes, return the symbol as a plain nonterminal.
-; Nonterminals are eq whenever they have identical symbols and attribute lists.
-(defun make-attributed-nonterminal (symbol attributes)
-  (assert-type symbol keyword)
-  (assert-type attributes (list nonterminal-attribute))
-  (if attributes
-    (let ((generic-nonterminals (get symbol 'generic-nonterminals)))
-      (or (cdr (assoc attributes generic-nonterminals :test #'equal))
-          (let ((attributed-nonterminal (allocate-attributed-nonterminal symbol attributes)))
-            (setf (get symbol 'generic-nonterminals)
-                  (acons attributes attributed-nonterminal generic-nonterminals))
-            attributed-nonterminal)))
-    symbol))
-
-
-(defmethod print-object ((attributed-nonterminal attributed-nonterminal) stream)
-  (print-unreadable-object (attributed-nonterminal stream)
-    (format stream "a ~@_~W~{ ~:_~W~}"
-            (attributed-nonterminal-symbol attributed-nonterminal)
-            (attributed-nonterminal-attributes attributed-nonterminal))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; GENERIC NONTERMINALS
-
-; A generic-nonterminal is a parametrized nonterminal that can expand into two or more
-; attributed-nonterminals.
-(defstruct (generic-nonterminal (:constructor allocate-generic-nonterminal (symbol parameters))
-                                (:copier nil)
-                                (:predicate generic-nonterminal?))
-  (symbol nil :type keyword :read-only t)    ;The name of the generic nonterminal
-  (parameters nil :type list :read-only t))  ;Ordered list of nonterminal attributes or arguments
-
-
-; Make a generic nonterminal with the given symbol and parameters.  If none of
-; the parameters is an argument, make an attributed nonterminal instead.  If there
-; are no parameters, return the symbol as a plain nonterminal.
-; Nonterminals are eq whenever they have identical symbols and parameter lists.
-(defun make-generic-nonterminal (symbol parameters)
-  (assert-type symbol keyword)
-  (if parameters
-    (let ((generic-nonterminals (get symbol 'generic-nonterminals)))
-      (or (cdr (assoc parameters generic-nonterminals :test #'equal))
-          (progn
-            (assert-type parameters (list nonterminal-parameter))
-            (let ((generic-nonterminal (if (every #'nonterminal-attribute? parameters)
-                                         (allocate-attributed-nonterminal symbol parameters)
-                                         (allocate-generic-nonterminal symbol parameters))))
-              (setf (get symbol 'generic-nonterminals)
-                    (acons parameters generic-nonterminal generic-nonterminals))
-              generic-nonterminal))))
-    symbol))
-
-
-(defmethod print-object ((generic-nonterminal generic-nonterminal) stream)
-  (print-unreadable-object (generic-nonterminal stream)
-    (format stream "g ~@_~W~{ ~:_~W~}"
-            (generic-nonterminal-symbol generic-nonterminal)
-            (generic-nonterminal-parameters generic-nonterminal))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; NONTERMINALS
-
-;;; A nonterminal is a keyword or an attributed-nonterminal.
-(declaim (inline nonterminal?))
-(defun nonterminal? (x)
-  (or (keywordp x) (attributed-nonterminal? x)))
-
-; The following nonterminals are reserved and may not be used in user input:
-;   :%   Nonterminal that expands to the start nonterminal
-
-(defconstant *start-nonterminal* :%)
-
-(deftype nonterminal () '(or keyword attributed-nonterminal))
-(deftype user-nonterminal () `(and nonterminal (not (eql ,*start-nonterminal*))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; GENERAL NONTERMINALS
-
-;;; A general-nonterminal is a nonterminal or a generic-nonterminal.
-(declaim (inline general-nonterminal?))
-(defun general-nonterminal? (x)
-  (or (nonterminal? x) (generic-nonterminal? x)))
-
-(deftype general-nonterminal () '(or nonterminal generic-nonterminal))
-
-
-; Return the list of parameters in the general-nonterminal.  The list is empty if the
-; general-nonterminal is a plain nonterminal.
-(defun general-nonterminal-parameters (general-nonterminal)
-  (cond
-   ((attributed-nonterminal? general-nonterminal) (attributed-nonterminal-attributes general-nonterminal))
-   ((generic-nonterminal? general-nonterminal) (generic-nonterminal-parameters general-nonterminal))
-   (t (progn
-        (assert-true (keywordp general-nonterminal))
-        nil))))
-
-
-; Emit markup for a general-nonterminal.  subscript is an optional integer.
-; link should be one of:
-;   :reference   if this is a reference of this general-nonterminal;
-;   :external    if this is an external reference of this general-nonterminal;
-;   :definition  if this is a definition of this general-nonterminal;
-;   nil          if this use of the general-nonterminal should not be cross-referenced.
-(defun depict-general-nonterminal (markup-stream general-nonterminal link &optional subscript)
-  (labels
-    ((depict-nonterminal-name (markup-stream symbol)
-       (let ((name (symbol-upper-mixed-case-name symbol)))
-         (depict-link (markup-stream link "N-" name t)
-           (depict markup-stream name))))
-     
-     (depict-nonterminal-parameter (markup-stream parameter)
-       (if (nonterminal-attribute? parameter)
-         (depict-char-style (markup-stream ':nonterminal-attribute)
-           (depict markup-stream (symbol-lower-mixed-case-name parameter)))
-         (depict-nonterminal-argument-symbol markup-stream parameter)))
-     
-     (depict-parametrized-nonterminal (markup-stream symbol parameters)
-       (depict-nonterminal-name markup-stream symbol)
-       (depict-char-style (markup-stream ':superscript)
-         (depict-list markup-stream #'depict-nonterminal-parameter parameters
-                      :separator ",")))
-     
-     (depict-general (markup-stream)      
-       (depict-char-style (markup-stream ':nonterminal)
-         (cond
-          ((keywordp general-nonterminal)
-           (depict-nonterminal-name markup-stream general-nonterminal))
-          ((attributed-nonterminal? general-nonterminal)
-           (depict-parametrized-nonterminal markup-stream
-                                            (attributed-nonterminal-symbol general-nonterminal)
-                                            (attributed-nonterminal-attributes general-nonterminal)))
-          ((generic-nonterminal? general-nonterminal)
-           (depict-parametrized-nonterminal markup-stream
-                                            (generic-nonterminal-symbol general-nonterminal)
-                                            (generic-nonterminal-parameters general-nonterminal)))
-          (t (error "Bad nonterminal ~S" general-nonterminal)))
-         (when subscript
-           (depict-char-style (markup-stream ':plain-subscript)
-             (depict-integer markup-stream subscript))))))
-    
-    (if (or (eq link :definition)
-            (and (or (eq link :reference) (eq link :external))
-                 (keywordp general-nonterminal)
-                 (null subscript)))
-      (depict-link (markup-stream link "N-" (symbol-upper-mixed-case-name (general-grammar-symbol-symbol general-nonterminal)) t)
-        (setq link nil)
-        (depict-general markup-stream))
-      (depict-general markup-stream))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; GRAMMAR SYMBOLS
-
-;;; A grammar-symbol is either a terminal or a nonterminal.
-(deftype grammar-symbol () '(or terminal nonterminal))
-(deftype user-grammar-symbol () '(or user-terminal user-nonterminal))
-
-;;; A general-grammar-symbol is either a terminal or a general-nonterminal.
-(deftype general-grammar-symbol () '(or terminal general-nonterminal))
-
-; Return true if x is a general-grammar-symbol.  x can be any object.
-(defun general-grammar-symbol? (x)
-  (or (terminal? x) (general-nonterminal? x)))
-
-
-; Return true if the two grammar symbols are the same symbol.
-(declaim (inline grammar-symbol-=))
-(defun grammar-symbol-= (grammar-symbol1 grammar-symbol2)
-  (eql grammar-symbol1 grammar-symbol2))
-; A version of grammar-symbol-= suitable for being the test function for hash tables.
-(defparameter *grammar-symbol-=* #'eql)
-
-
-; Return the general-grammar-symbol's symbol.  Return it unchanged if it is not
-; an attributed or generic nonterminal.
-(defun general-grammar-symbol-symbol (general-grammar-symbol)
-  (cond
-   ((attributed-nonterminal? general-grammar-symbol) (attributed-nonterminal-symbol general-grammar-symbol))
-   ((generic-nonterminal? general-grammar-symbol) (generic-nonterminal-symbol general-grammar-symbol))
-   (t (assert-type general-grammar-symbol (or keyword terminal)))))
-
-
-; Return the list of arguments in the general-grammar-symbol.  The list is empty if the
-; general-grammar-symbol is not a generic nonterminal.
-(defun general-grammar-symbol-arguments (general-grammar-symbol)
-  (and (generic-nonterminal? general-grammar-symbol)
-       (remove-if (complement #'nonterminal-argument?) (generic-nonterminal-parameters general-grammar-symbol))))
-
-
-; Return the general-grammar-symbol expanded into source form that can be interned to yield the same
-; general-grammar-symbol.
-(defun general-grammar-symbol-source (general-grammar-symbol)
-  (cond
-   ((attributed-nonterminal? general-grammar-symbol)
-    (cons (attributed-nonterminal-symbol general-grammar-symbol) (attributed-nonterminal-attributes general-grammar-symbol)))
-   ((generic-nonterminal? general-grammar-symbol)
-    (cons (generic-nonterminal-symbol general-grammar-symbol) (generic-nonterminal-parameters general-grammar-symbol)))
-   (t (assert-type general-grammar-symbol (or keyword terminal)))))
-
-
-; Emit markup for a general-grammar-symbol.  subscript is an optional integer.
-; link should be one of:
-;   :reference   if this is a reference of this general-grammar-symbol;
-;   :external    if this is an external reference of this general-grammar-symbol;
-;   :definition  if this is a definition of this general-grammar-symbol;
-;   nil          if this use of the general-grammar-symbol should not be cross-referenced.
-(defun depict-general-grammar-symbol (markup-stream general-grammar-symbol link &optional subscript)
-  (if (general-nonterminal? general-grammar-symbol)
-    (depict-general-nonterminal markup-stream general-grammar-symbol link subscript)
-    (depict-terminal markup-stream general-grammar-symbol subscript)))
-
-
-; Styled text can include (:grammar-symbol <grammar-symbol-source> [<subscript>]) as long as
-; *styled-text-grammar-parametrization* is bound around the call to depict-styled-text.
-(defvar *styled-text-grammar-parametrization*)
-
-(defun depict-grammar-symbol-styled-text (markup-stream grammar-symbol-source &optional subscript)
-  (depict-general-grammar-symbol markup-stream
-                                 (grammar-parametrization-intern *styled-text-grammar-parametrization* grammar-symbol-source)
-                                 :reference
-                                 subscript))
-
-(setf (styled-text-depictor :grammar-symbol) #'depict-grammar-symbol-styled-text)
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; GRAMMAR PARAMETRIZATIONS
-
-; A grammar parametrization holds the rules for converting nonterminal arguments into nonterminal attributes.
-(defstruct (grammar-parametrization (:constructor allocate-grammar-parametrization (argument-attributes))
-                                    (:predicate grammar-parametrization?))
-  (argument-attributes nil :type hash-table :read-only t))   ;Hash table of nonterminal-argument -> list of nonterminal-attributes
-
-
-(defun make-grammar-parametrization ()
-  (allocate-grammar-parametrization (make-hash-table :test #'eq)))
-
-
-; Return true if the two grammar-parametrizations are the same.
-(defun grammar-parametrization-= (grammar-parametrization1 grammar-parametrization2)
-  (hash-table-= (grammar-parametrization-argument-attributes grammar-parametrization1)
-                (grammar-parametrization-argument-attributes grammar-parametrization2)
-                :test #'equal))
-
-
-; Declare that nonterminal arguments with the given name can hold any of the
-; given nonterminal attributes given.  At least one attribute must be provided.
-(defun grammar-parametrization-declare-argument (grammar-parametrization argument attributes)
-  (assert-type argument nonterminal-argument)
-  (assert-type attributes (list nonterminal-attribute))
-  (assert-true attributes)
-  (when (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization))
-    (error "Duplicate parametrized grammar argument ~S" argument))
-  (setf (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization)) attributes))
-
-
-; Return the attributes to which the given argument may expand.
-(defun grammar-parametrization-lookup-argument (grammar-parametrization argument)
-  (assert-non-null (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization))))
-
-
-; Create a plain, attributed, or generic grammar symbol from the specification in grammar-symbol-source.
-; If grammar-symbol-source is not a cons, it is a plain grammar symbol.  If it is a list, its first element
-; must be a keyword that is a nonterminal's symbol and the other elements must be nonterminal
-; parameters.
-; Return two values:
-;   the grammar symbol
-;   a list of arguments used in the grammar symbol.
-; If allowed-arguments is given, check that each argument is in the allowed-arguments list;
-; if not, allow any arguments declared in grammar-parametrization but do not allow duplicates.
-(defun grammar-parametrization-intern (grammar-parametrization grammar-symbol-source &optional (allowed-arguments nil allow-duplicates))
-  (if (consp grammar-symbol-source)
-    (progn
-      (assert-type grammar-symbol-source (cons keyword (list nonterminal-parameter)))
-      (let* ((symbol (car grammar-symbol-source))
-             (parameters (cdr grammar-symbol-source))
-             (arguments (remove-if (complement #'nonterminal-argument?) parameters)))
-        (mapl #'(lambda (arguments)
-                  (let ((argument (car arguments)))
-                    (if allow-duplicates
-                      (unless (member argument allowed-arguments :test #'eq)
-                        (error "Undefined nonterminal argument ~S" argument))
-                      (progn
-                        (unless (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization))
-                          (error "Undeclared nonterminal argument ~S" argument))
-                        (when (member argument (cdr arguments) :test #'eq)
-                          (error "Duplicate nonterminal argument ~S" argument))))))
-              arguments)
-        (values (make-generic-nonterminal symbol parameters) arguments)))
-    (values (assert-type grammar-symbol-source (or keyword terminal)) nil)))
-
-
-; Call f on each possible binding permutation of the given arguments concatenated with the bindings in
-; bound-argument-alist.  f takes one argument, an association list that maps arguments to attributes.
-(defun grammar-parametrization-each-permutation (grammar-parametrization f arguments &optional bound-argument-alist)
-  (if arguments
-    (let ((argument (car arguments))
-          (rest-arguments (cdr arguments)))
-      (dolist (attribute (grammar-parametrization-lookup-argument grammar-parametrization argument))
-        (grammar-parametrization-each-permutation grammar-parametrization f rest-arguments (acons argument attribute bound-argument-alist))))
-    (funcall f bound-argument-alist)))
-
-
-; If general-grammar-symbol is a generic-nonterminal, return one possible binding permutation of its arguments;
-; otherwise return nil.
-(defun nonterminal-sample-bound-argument-alist (grammar-parametrization general-grammar-symbol)
-  (when (generic-nonterminal? general-grammar-symbol)
-    (grammar-parametrization-each-permutation
-     grammar-parametrization
-     #'(lambda (bound-argument-alist) (return-from nonterminal-sample-bound-argument-alist bound-argument-alist))
-     (general-grammar-symbol-arguments general-grammar-symbol))))
-
-
-; If the grammar symbol is a generic nonterminal, convert it into an attributed nonterminal
-; by instantiating its arguments with the corresponding attributes from the bound-argument-alist.
-; If the grammar symbol is already an attributed or plain nonterminal, return it unchanged.
-(defun instantiate-general-grammar-symbol (bound-argument-alist general-grammar-symbol)
-  (if (generic-nonterminal? general-grammar-symbol)
-    (make-attributed-nonterminal
-     (generic-nonterminal-symbol general-grammar-symbol)
-     (mapcar #'(lambda (parameter)
-                 (if (nonterminal-argument? parameter)
-                   (let ((binding (assoc parameter bound-argument-alist :test #'eq)))
-                     (if binding
-                       (cdr binding)
-                       (error "Unbound nonterminal argument ~S" parameter)))
-                   parameter))
-             (generic-nonterminal-parameters general-grammar-symbol)))
-    (assert-type general-grammar-symbol grammar-symbol)))
-
-
-; If the grammar symbol is a generic nonterminal parametrized on argument, substitute
-; attribute for argument in it and return the modified grammar symbol.  Otherwise, return it unchanged.
-(defun general-grammar-symbol-substitute (attribute argument general-grammar-symbol)
-  (assert-type attribute nonterminal-attribute)
-  (assert-type argument nonterminal-argument)
-  (if (and (generic-nonterminal? general-grammar-symbol)
-           (member argument (generic-nonterminal-parameters general-grammar-symbol) :test #'eq))
-    (make-generic-nonterminal
-     (generic-nonterminal-symbol general-grammar-symbol)
-     (substitute attribute argument (generic-nonterminal-parameters general-grammar-symbol) :test #'eq))
-    (assert-type general-grammar-symbol general-grammar-symbol)))
-
-
-; If the general grammar symbol is a generic nonterminal, return a list of all possible attributed nonterminals
-; that can be instantiated from it; otherwise, return a one-element list containing the given general grammar symbol.
-(defun general-grammar-symbol-instances (grammar-parametrization general-grammar-symbol)
-  (if (generic-nonterminal? general-grammar-symbol)
-    (let ((instances nil))
-      (grammar-parametrization-each-permutation
-       grammar-parametrization
-       #'(lambda (bound-argument-alist)
-           (push (instantiate-general-grammar-symbol bound-argument-alist general-grammar-symbol) instances))
-       (general-grammar-symbol-arguments general-grammar-symbol))
-      (nreverse instances))
-    (list (assert-type general-grammar-symbol grammar-symbol))))
-
-
-; Return true if grammar-symbol can be obtained by calling instantiate-general-grammar-symbol on
-; general-grammar-symbol.
-(defun general-nonterminal-is-instance? (grammar-parametrization general-grammar-symbol grammar-symbol)
-  (or (grammar-symbol-= general-grammar-symbol grammar-symbol)
-      (and (generic-nonterminal? general-grammar-symbol)
-           (attributed-nonterminal? grammar-symbol)
-           (let ((parameters (generic-nonterminal-parameters general-grammar-symbol))
-                 (attributes (attributed-nonterminal-attributes grammar-symbol)))
-             (and (= (length parameters) (length attributes))
-                  (every #'(lambda (parameter attribute)
-                             (or (eq parameter attribute)
-                                 (and (nonterminal-argument? parameter)
-                                      (member attribute (grammar-parametrization-lookup-argument grammar-parametrization parameter) :test #'eq))))
-                         parameters
-                         attributes))))))

mozilla/js2/semantics/HTML-To-RTF/Convert.lisp

@@ -1,485 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; Custom HTML-to-RTF Converter
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-(defconstant *missing-marker* "*****")
-
-
-; Return the html-name-token of the tag of the given html element.
-(defun tag-name (element)
-  (html-parser:name (instance-of element)))
-
-
-(defun match-tag-name (element tag-name)
-  (eq (tag-name element) tag-name))
-
-
-; Return the value of the given attribute in <element> or nil if not found.
-(defun attribute-value (element attribute-name)
-  (cdr (assoc attribute-name (attr-values element) :key #'html-parser:name)))
-
-
-; Return true if the element has the given given <tag-name>, all of required-attributes, and perhaps
-; the optional-attributes.
-(defun match-element (element tag-name required-attributes optional-attributes)
-  (and (match-tag-name element tag-name)
-       (let ((attribute-values (attr-values element)))
-         (and
-          (every #'(lambda (required-attribute)
-                     (assoc required-attribute attribute-values :key #'html-parser:name))
-                 required-attributes)
-          (every #'(lambda (attribute-value)
-                     (let ((attribute (html-parser:name (car attribute-value))))
-                       (or (member attribute required-attributes)
-                           (member attribute optional-attributes))))
-                 attribute-values)))))
-
-
-; Ensure that <element> has the given given <tag-name>, all of required-attributes, and perhaps
-; the optional-attributes.
-(defun ensure-element (element tag-name required-attributes optional-attributes)
-  (unless (match-element element tag-name required-attributes optional-attributes)
-    (error "Tag ~S ~S ~S expected; got ~S" tag-name required-attributes optional-attributes element)))
-
-
-; Return the children of <element> that have the given <tag-name>, all of required-attributes, and perhaps
-; the optional-attributes.
-(defun matching-parts (element tag-name required-attributes optional-attributes)
-  (remove-if-not #'(lambda (child) (match-element child tag-name required-attributes optional-attributes))
-                 (parts element)))
-
-
-; Return the unique child of <element> that has the given <tag-name>, all of required-attributes, and perhaps
-; the optional-attributes.
-(defun matching-part (element tag-name required-attributes optional-attributes)
-  (let ((parts (matching-parts element tag-name required-attributes optional-attributes)))
-    (unless (and parts (endp (cdr parts)))
-      (error "Element ~S should have only one ~S child" element tag-name))
-    (car parts)))
-
-
-; Convert control characters in the given string into spaces.
-(defun normalize (string)
-  (let ((l nil))
-    (dotimes (i (length string))
-      (let ((ch (char string i)))
-        (if (<= (char-code ch) 32)
-          (unless (eql (car l) #\Space)
-            (push #\Space l))
-          (push ch l))))
-    (coerce (nreverse l) 'string)))
-
-
-(defun normalize-preformatted (string)
-  (map 'list #'(lambda (ch)
-                 (if (< (char-code ch) 32)
-                   'line
-                   (string ch)))
-       string))
-
-
-(defvar *preformatted* nil)
-
-(defun emit-string (markup-stream string)
-  (if *preformatted*
-    (dolist (segment (normalize-preformatted string))
-      (depict markup-stream segment))
-    (depict markup-stream (normalize string))))
-
-
-(defparameter *special-char-code-map*
-  '((#x0097 . endash)
-    (#x00AB . :left-angle-quote)
-    (#x00BB . :right-angle-quote)
-    (#x2018 . :left-single-quote)
-    (#x2019 . :right-single-quote)
-    (#x201C . :left-double-quote)
-    (#x201D . :right-double-quote)))
-
-
-(defun emit-special-character (markup-stream char-num)
-  (let ((code (cdr (assoc char-num *special-char-code-map*))))
-    (if code
-      (depict markup-stream code)
-      (progn
-        (depict markup-stream *missing-marker*)
-        (format *terminal-io* "Ignoring character code ~S~%" char-num)))))
-
-
-(defparameter *character-style-map*
-  '(("control" . :character-literal-control)
-    ("terminal" . :terminal)
-    ("terminal-keyword" . :terminal-keyword)
-    ("nonterminal" . :nonterminal)
-    ("nonterminal-attribute" . :nonterminal-attribute)
-    ("nonterminal-argument" . :nonterminal-argument)
-    ("semantic-keyword" . :semantic-keyword)
-    ("type-expression" . :type-expression)
-    ("type-name" . :type-name)
-    ("field-name" . :field-name)
-    ("id-name" . :id-name)
-    ("global-variable" . :global-variable)
-    ("local-variable" . :local-variable)
-    ("action-name" . :action-name)
-    ("sub" . sub)
-    ("sub-num" . :plain-subscript)))
-
-
-(defun class-to-character-style (element)
-  (let ((class (attribute-value element '#t"CLASS")))
-    (if (null class)
-      nil
-      (let ((style (cdr (assoc class *character-style-map* :test #'equal))))
-        (unless style
-          (format *terminal-io* "Ignoring character style ~S~%" class))
-        style))))
-
-
-(defparameter *u-styles*
-  '(("U_bull" . :bullet)
-    ("U_ne" . :not-equal)
-    ("U_le" . :less-or-equal)
-    ("U_ge" . :greater-or-equal)
-    ("U_infin" . :infinity)
-    ("U_perp" . :bottom-10)
-    ("U_larr" . :vector-assign-10)
-    ("U_uarr" . :up-arrow-10)
-    ("U_rarr" . :function-arrow-10)
-    ("U_times" . :cartesian-product-10)
-    ("U_equiv" . :identical-10)
-    ("U_oplus" . :circle-plus-10)
-    ("U_empty" . :empty-10)
-    ("U_cap" . :intersection-10)
-    ("U_cup" . :union-10)
-    ("U_isin" . :member-10)
-    ("U_notin" . :not-member-10)
-    ("U_rArr" . :derives-10)
-    ("U_lang" . :left-triangle-bracket-10)
-    ("U_rang" . :right-triangle-bracket-10)
-    
-    ("U_alpha" . :alpha)
-    ("U_beta" . :beta)
-    ("U_chi" . :chi)
-    ("U_delta" . :delta)
-    ("U_epsilon" . :epsilon)
-    ("U_phi" . :phi)
-    ("U_gamma" . :gamma)
-    ("U_eta" . :eta)
-    ("U_iota" . :iota)
-    ("U_kappa" . :kappa)
-    ("U_lambda" . :lambda)
-    ("U_mu" . :mu)
-    ("U_nu" . :nu)
-    ("U_omicron" . :omicron)
-    ("U_pi" . :pi)
-    ("U_theta" . :theta)
-    ("U_rho" . :rho)
-    ("U_sigma" . :sigma)
-    ("U_tau" . :tau)
-    ("U_upsilon" . :upsilon)
-    ("U_omega" . :omega)
-    ("U_xi" . :xi)
-    ("U_psi" . :psi)
-    ("U_zeta" . :zeta)
-    
-    ("U_Omega" . :capital-omega)))
-
-(defun emit-script-element (markup-stream element)
-  (let* ((children (parts element))
-         (child (first children)))
-    (if (and
-         (= (length children) 1)
-         (stringp child)
-         (> (length child) 16)
-         (equal (subseq child 0 15) "document.write(")
-         (eql (char child (1- (length child))) #\)))
-      (let* ((u-name (subseq child 15 (1- (length child))))
-             (u-style (cdr (assoc u-name *u-styles* :test #'equal))))
-        (if u-style
-          (depict markup-stream u-style)
-          (progn
-            (depict markup-stream *missing-marker*)
-            (format *terminal-io* "Ignoring SCRIPT element ~S ~S~%" element child))))
-      (progn
-        (depict markup-stream *missing-marker*)
-        (format *terminal-io* "Ignoring SCRIPT element ~S ~S~%" element children)))))
-
-
-(defparameter *entity-map*
-  '((#e"nbsp" . ~)
-    (#e"lt" . "<")
-    (#e"gt" . ">")
-    (#e"amp" . "&")
-    (#e"quot" . "\"")))
-
-(defun emit-entity (markup-stream entity)
-  (let ((rtf (cdr (assoc entity *entity-map*))))
-    (if rtf
-      (depict markup-stream rtf)
-      (progn
-        (depict markup-stream "*****[" (html-parser:token-name entity) "]")
-        (format *terminal-io* "Ignoring entity ~S~%" entity)))))
-
-
-(defparameter *inline-element-map*
-  '((#t"VAR" . :variable)
-    (#t"B" . b)
-    (#t"I" . i)
-    (#t"TT" . :courier)
-    (#t"SUB" . sub)))
-
-(defun emit-inline-element (markup-stream element)
-  (cond
-   ((stringp element)
-    (emit-string markup-stream element))
-   ((integerp element)
-    (emit-special-character markup-stream element))
-   ((typep element 'html-entity-token)
-    (emit-entity markup-stream element))
-   ((match-element element '#t"SCRIPT" '(#t"TYPE") nil)
-    (emit-script-element markup-stream element))
-   ((or
-     (match-element element '#t"A" nil '(#t"CLASS" #t"HREF" #t"NAME"))
-     (match-element element '#t"SPAN" nil '(#t"CLASS"))
-     (match-element element '#t"VAR" '(#t"CLASS") nil))
-    (depict-char-style (markup-stream (class-to-character-style element))
-      (emit-inline-parts markup-stream element)))
-   ((match-element element '#t"CODE" nil '(#t"CLASS"))
-    (let ((class (attribute-value element '#t"CLASS")))
-      (if (equal class "terminal-keyword")
-        (depict-char-style (markup-stream (class-to-character-style element))
-          (emit-inline-parts markup-stream element))
-        (progn
-          (when class
-            (format *terminal-io* "Ignoring CODE character style ~S~%" class))
-          (depict-char-style (markup-stream :character-literal)
-            (emit-inline-parts markup-stream element))))))
-   ((match-element element '#t"SUP" nil '(#t"CLASS"))
-    (depict-char-style (markup-stream 'super)
-      (depict-char-style (markup-stream (class-to-character-style element))
-        (emit-inline-parts markup-stream element))))
-   ((match-element element '#t"BR" nil nil)
-    (depict markup-stream :new-line))
-   (t (let ((inline-style (cdr (assoc (tag-name element) *inline-element-map*))))
-        (if (and inline-style (endp (attr-values element)))
-          (depict-char-style (markup-stream inline-style)
-            (emit-inline-parts markup-stream element))
-          (progn
-            (depict markup-stream *missing-marker*)
-            (format *terminal-io* "Ignoring inline element ~S~%" element)))))))
-
-
-; Emit the children of the given element as inline elements.
-(defun emit-inline-parts (markup-stream element)
-  (dolist (child (parts element))
-    (emit-inline-element markup-stream child)))
-
-
-; Emit the children of the given element as inline elements in a paragraph of the given style.
-; However, if some children are paragraph-level elements, emit them as separate paragraphs.
-(defun emit-inline-or-paragraph-parts (markup-stream element paragraph-style)
-  (emit-inline-or-paragraph-elements markup-stream (parts element) paragraph-style ))
-
-(defparameter *paragraph-elements*
-  '(#t"P" #t"TH" #t"TD" #t"PRE" #t"UL" #t"OL" #t"DIV" #t"HR" #t"TABLE" #t"H1" #t"H2" #t"H3" #t"H4"))
-
-(defun paragraph-element? (element)
-  (and (typep element 'html-tag-instance)
-       (member (tag-name element) *paragraph-elements*)))
-
-(defun emit-inline-or-paragraph-elements (markup-stream elements paragraph-style)
-  (let* ((paragraph-element (member-if #'paragraph-element? elements))
-         (inline-parts (ldiff elements paragraph-element)))
-    (when inline-parts
-      (depict-paragraph (markup-stream paragraph-style)
-        (dolist (child inline-parts)
-          (emit-inline-element markup-stream child))))
-    (when paragraph-element
-      (emit-paragraph-element markup-stream (car paragraph-element))
-      (emit-inline-or-paragraph-elements markup-stream (cdr paragraph-element) paragraph-style))))
-
-
-(defparameter *class-paragraph-styles*
-  '(("mod-date" . :mod-date)
-    ("grammar-argument" . :grammar-argument)
-    ("indent" . :body-text)
-    ("operator-heading" . :heading4)
-    ("semantics" . :semantics)
-    ("semantics-next" . :semantics-next)))
-
-
-(defun class-to-paragraph-style (element)
-  (let ((class (attribute-value element '#t"CLASS")))
-    (if class
-      (let ((style (cdr (assoc class *class-paragraph-styles* :test #'equal))))
-        (or style
-            (progn
-              (format *terminal-io* "Ignoring paragraph style ~S~%" class)
-              :body-text)))
-      :body-text)))
-
-
-(defun grammar-rule-child-style (element last)
-  (and
-   (match-element element '#t"DIV" '(#t"CLASS") nil)
-   (let ((class (attribute-value element '#t"CLASS")))
-     (cond
-      ((equal class "grammar-lhs")
-       (if last :grammar-lhs-last :grammar-lhs))
-      ((equal class "grammar-rhs")
-       (if last :grammar-rhs-last :grammar-rhs))
-      (t nil)))))
-
-
-(defparameter *divs-containing-divs*
-  '("indent"))
-
-(defun emit-div (markup-stream element class)
-  (cond
-   ((equal class "grammar-rule")
-    (let ((children (parts element)))
-      (do ()
-          ((endp children))
-        (let* ((child (pop children))
-               (style (grammar-rule-child-style child (endp children))))
-          (unless style
-            (format *terminal-io* "Bad grammar-rule child ~S~%" child)
-            (setq style :body-text))
-          (depict-paragraph (markup-stream style)
-            (emit-inline-parts markup-stream child))))))
-   ((member class *divs-containing-divs* :test #'equal)
-    (depict-paragraph (markup-stream :body-text)
-      (depict markup-stream "***** BEGIN DIV" class))
-    (emit-paragraph-elements markup-stream element)
-    (depict-paragraph (markup-stream :body-text)
-      (depict markup-stream "***** END DIV" class)))
-   (t (emit-inline-or-paragraph-parts markup-stream element (class-to-paragraph-style element)))))
-
-
-(defparameter *paragraph-element-map*
-  '((#t"H1" . :heading1)
-    (#t"H2" . :heading2)
-    (#t"H3" . :heading3)
-    (#t"H4" . :heading4)))
-
-
-; Emit the paragraph-level element.
-(defun emit-paragraph-element (markup-stream element)
-  (cond
-   ((or
-     (match-element element '#t"P" nil '(#t"CLASS"))
-     (match-element element '#t"TH" nil '(#t"CLASS" #t"COLSPAN" #t"ROWSPAN" #t"NOWRAP" #t"VALIGN" #t"ALIGN"))
-     (match-element element '#t"TD" nil '(#t"CLASS" #t"COLSPAN" #t"ROWSPAN" #t"NOWRAP" #t"VALIGN" #t"ALIGN")))
-    (emit-inline-or-paragraph-parts markup-stream element (class-to-paragraph-style element)))
-   ((match-element element '#t"PRE" nil nil)
-    (depict-paragraph (markup-stream :sample-code)
-      (let ((*preformatted* t))
-        (emit-inline-parts markup-stream element))))
-   ((or (match-element element '#t"UL" nil nil)
-        (match-element element '#t"OL" nil nil))
-    (depict-paragraph (markup-stream :body-text)
-      (depict markup-stream "***** BEGIN LIST"))
-    (dolist (child (parts element))
-      (ensure-element child '#t"LI" nil nil)
-      (emit-inline-or-paragraph-parts markup-stream child :body-text))
-    (depict-paragraph (markup-stream :body-text)
-      (depict markup-stream "***** END LIST")))
-   ((match-element element '#t"DIV" nil '(#t"CLASS"))
-    (let ((class (attribute-value element '#t"CLASS")))
-      (if class
-        (emit-div markup-stream element class)
-        (emit-paragraph-elements markup-stream element))))
-   ((match-element element '#t"HR" nil nil))
-   ((match-element element '#t"TABLE" nil '(#t"BORDER" #t"CELLSPACING" #t"CELLPADDING"))
-    (depict-paragraph (markup-stream :body-text)
-      (depict markup-stream "***** BEGIN TABLE"))
-    (emit-paragraph-elements markup-stream element)
-    (depict-paragraph (markup-stream :body-text)
-      (depict markup-stream "***** END TABLE")))
-   ((match-element element '#t"THEAD" nil nil)
-    (emit-paragraph-elements markup-stream element))
-   ((match-element element '#t"TR" nil nil)
-    (emit-paragraph-elements markup-stream element))
-   (t (let ((paragraph-style (cdr (assoc (tag-name element) *paragraph-element-map*))))
-        (if (and paragraph-style (endp (attr-values element)))
-          (emit-inline-or-paragraph-parts markup-stream element paragraph-style)
-          (progn
-            (depict-paragraph (markup-stream :body-text)
-              (depict markup-stream *missing-marker*))
-            (format *terminal-io* "Ignoring paragraph element ~S~%" element)))))))
-
-
-; Emit the children of the given element as paragraph-level elements.
-(defun emit-paragraph-elements (markup-stream element)
-  (dolist (child (parts element))
-    (emit-paragraph-element markup-stream child)))
-
-
-(defun emit-html-file (markup-stream element)
-  (ensure-element element '#t"HTML" nil nil)
-  (let* ((body (matching-part element '#t"BODY" nil nil))
-         (body-elements (parts body)))
-    (when (and body-elements (match-tag-name (first body-elements) '#t"TABLE"))
-      (setq body-elements (rest body-elements)))
-    (when (and body-elements (match-tag-name (car (last body-elements)) '#t"TABLE"))
-      (setq body-elements (butlast body-elements)))
-    (dolist (body-element body-elements)
-      (emit-paragraph-element markup-stream body-element))))
-
-
-(defun translate-html-to-rtf (html-file-name rtf-path title)
-  (let* ((source-text (file->string html-file-name))
-         (element (html-parser::simple-parser source-text)))
-    (depict-rtf-to-local-file
-     rtf-path
-     title
-     #'(lambda (markup-stream)
-         (emit-html-file markup-stream element))
-     *html-to-rtf-definitions*)))
-
-#|
-(setq s (html-parser:file->string "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:formal:index.html"))
-(setq p (html-parser::simple-parser s))
-
-(depict-rtf-to-local-file
- "HTML-To-RTF/Test.rtf"
- "Test"
- #'(lambda (markup-stream)
-     (emit-html-file markup-stream p))
- *html-to-rtf-definitions*)
-
-(translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:formal:index.html" "HTML-To-RTF/Test.rtf" "Test")
-(translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:introduction:notation.html"
-                       "HTML-To-RTF/Notation.rtf" "Notation")
-(translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:es4:core:expressions.html"
-                       "HTML-To-RTF/Expressions.rtf" "Expressions")
-(translate-html-to-rtf "Huit:Mozilla:Moz:mozilla:js2:semantics:HTML-To-RTF:Expressions.html"
-                       "HTML-To-RTF/Expressions.rtf" "Expressions")
-
-(translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:formal:stages.html"
-                       "HTML-To-RTF/Stages.rtf" "Stages")
-(translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:formal:notation.html"
-                       "HTML-To-RTF/FormalNotation.rtf" "Formal Notation")
-|#

mozilla/js2/semantics/HTML-To-RTF/Main.lisp

@@ -1,96 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; Custom HTML-to-RTF Converter
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-(defparameter *html-to-rtf-filenames*
-  '("../Utilities" "../Markup" "../RTF" "Convert"))
-
-(defparameter *html-to-rtf-directory*
-  (make-pathname
-   #+lispworks :host #+lispworks (pathname-host *load-truename*)
-   :directory (pathname-directory #-mcl *load-truename*
-                                  #+mcl (truename *loading-file-source-file*))))
-
-(defparameter *semantic-engine-directory*
-  (merge-pathnames (make-pathname :directory '(:relative :up)) *html-to-rtf-directory*))
-
-
-; Convert a filename string possibly containing slashes into a Lisp relative pathname.
-(defun filename-to-relative-pathname (filename)
-  (let ((directories nil))
-    (loop
-      (let ((slash (position #\/ filename)))
-        (if slash
-          (let ((dir-name (subseq filename 0 slash)))
-            (push (if (equal dir-name "..") :up dir-name) directories)
-            (setq filename (subseq filename (1+ slash))))
-          (return (if directories
-                    (make-pathname :directory (cons ':relative (nreverse directories)) :name filename #+lispworks :type #+lispworks "lisp")
-                    #-lispworks filename
-                    #+lispworks (make-pathname :name filename :type "lisp"))))))))
-
-
-; Convert a filename string possibly containing slashes relative to *html-to-rtf-directory*
-; into a Lisp absolute pathname.
-(defun filename-to-html-to-rtf-pathname (filename)
-  (merge-pathnames (filename-to-relative-pathname filename) *html-to-rtf-directory*))
-
-
-; Convert a filename string possibly containing slashes relative to *semantic-engine-directory*
-; into a Lisp absolute pathname.
-(defun filename-to-semantic-engine-pathname (filename)
-  (merge-pathnames (filename-to-relative-pathname filename) *semantic-engine-directory*))
-
-
-(defun operate-on-files (f files &rest options)
-  (with-compilation-unit ()
-    (dolist (filename files)
-      (apply f (filename-to-html-to-rtf-pathname filename) :verbose t options))))
-
-(defun compile-html-to-rtf ()
-  (operate-on-files #'compile-file *html-to-rtf-filenames* :load t))
-
-(defun load-html-to-rtf ()
-  (operate-on-files #-allegro #'load #+allegro #'load-compiled *html-to-rtf-filenames*))
-
-
-(defmacro with-local-output ((stream filename) &body body)
-  `(with-open-file (,stream (filename-to-html-to-rtf-pathname ,filename)
-                            :direction :output
-                            :if-exists :supersede)
-     ,@body))
-
-
-(load (filename-to-html-to-rtf-pathname "../HTML-Parser/mac-sysdcl"))
-(html-parser:initialize-parser)
-(import '(html-parser:file->string
-          html-parser:instance-of
-          html-parser:parts
-          html-parser:part-of
-          html-parser:attr-values
-          html-parser:html-entity-token
-          html-parser:html-tag-instance))
-
-(load-html-to-rtf)

mozilla/js2/semantics/HTML.lisp

@@ -1,696 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; HTML output generator
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; ELEMENTS
-
-(defstruct (html-element (:constructor make-html-element (name self-closing indent
-                                                               newlines-before newlines-begin newlines-end newlines-after))
-                         (:predicate html-element?))
-  (name nil :type symbol :read-only t)               ;Name of the tag
-  (self-closing nil :type bool :read-only t)         ;True if the closing tag should be omitted
-  (indent nil :type integer :read-only t)            ;Number of spaces by which to indent this tag's contents in HTML source
-  (newlines-before nil :type integer :read-only t)   ;Number of HTML source newlines preceding the opening tag
-  (newlines-begin nil :type integer :read-only t)    ;Number of HTML source newlines immediately following the opening tag
-  (newlines-end nil :type integer :read-only t)      ;Number of HTML source newlines immediately preceding the closing tag
-  (newlines-after nil :type integer :read-only t))   ;Number of HTML source newlines following the closing tag
-
-
-; Define symbol to refer to the given html-element.
-(defun define-html (symbol newlines-before newlines-begin newlines-end newlines-after &key self-closing (indent 0))
-  (setf (get symbol 'html-element) (make-html-element symbol self-closing indent
-                                                      newlines-before newlines-begin newlines-end newlines-after)))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; ELEMENT DEFINITIONS
-
-(define-html 'a 0 0 0 0)
-(define-html 'b 0 0 0 0)
-(define-html 'blockquote 1 0 0 1 :indent 2)
-(define-html 'body 1 1 1 1)
-(define-html 'br 0 0 0 1 :self-closing t)
-(define-html 'code 0 0 0 0)
-(define-html 'dd 1 0 0 1 :indent 2)
-(define-html 'del 0 0 0 0)
-(define-html 'div 1 0 0 1 :indent 2)
-(define-html 'dl 1 0 0 2 :indent 2)
-(define-html 'dt 1 0 0 1 :indent 2)
-(define-html 'em 0 0 0 0)
-(define-html 'h1 2 0 0 2 :indent 2)
-(define-html 'h2 2 0 0 2 :indent 2)
-(define-html 'h3 2 0 0 2 :indent 2)
-(define-html 'h4 1 0 0 2 :indent 2)
-(define-html 'h5 1 0 0 2 :indent 2)
-(define-html 'h6 1 0 0 2 :indent 2)
-(define-html 'head 1 1 1 2)
-(define-html 'hr 1 0 0 1 :self-closing t)
-(define-html 'html 0 1 1 1)
-(define-html 'i 0 0 0 0)
-(define-html 'li 1 0 0 1 :indent 2)
-(define-html 'link 1 0 0 1 :self-closing t)
-(define-html 'ol 1 1 1 2 :indent 2)
-(define-html 'p 1 0 0 2)
-(define-html 'script 0 0 0 0)
-(define-html 'span 0 0 0 0)
-(define-html 'strong 0 0 0 0)
-(define-html 'sub 0 0 0 0)
-(define-html 'sup 0 0 0 0)
-(define-html 'table 1 1 1 2)
-(define-html 'td 1 0 0 1 :indent 2)
-(define-html 'th 1 0 0 1 :indent 2)
-(define-html 'title 1 0 0 1)
-(define-html 'tr 1 0 0 1 :indent 2)
-(define-html 'u 0 0 0 0)
-(define-html 'ul 1 1 1 2 :indent 2)
-(define-html 'var 0 0 0 0)
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; ATTRIBUTES
-
-;;; The following element attributes require their values to always be in quotes.
-(dolist (attribute '(alt href name))
-  (setf (get attribute 'quoted-attribute) t))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; ENTITIES
-
-(defvar *html-entities-list*
-  '((#\& . "amp")
-    (#\" . "quot")
-    (#\< . "lt")
-    (#\> . "gt")
-    (nbsp . "nbsp")))
-
-(defvar *html-entities-hash* (make-hash-table))
-
-(dolist (entity-binding *html-entities-list*)
-  (setf (gethash (first entity-binding) *html-entities-hash*) (rest entity-binding)))
-
-
-; Return a freshly consed list of <html-source> that represent the characters in the string except that
-; '&', '<', and '>' are replaced by their entities and spaces are replaced by the entity
-; given by the space parameter (which should be either 'space or 'nbsp).
-(defun escape-html-characters (string space)
-  (let ((html-sources nil))
-    (labels
-      ((escape-remainder (start)
-         (let ((i (position-if #'(lambda (char) (member char '(#\& #\< #\> #\space))) string :start start)))
-           (if i
-             (let ((char (char string i)))
-               (unless (= i start)
-                 (push (subseq string start i) html-sources))
-               (push (if (eql char #\space) space char) html-sources)
-               (escape-remainder (1+ i)))
-             (push (if (zerop start) string (subseq string start)) html-sources)))))
-      (unless (zerop (length string))
-        (escape-remainder 0))
-      (nreverse html-sources))))
-
-
-; Escape all content strings in the html-source, while interpreting :nowrap, :wrap, and :none pseudo-tags.
-; Return a freshly consed list of html-sources.
-(defun escape-html-source (html-source space)
-  (cond
-   ((stringp html-source)
-    (escape-html-characters html-source space))
-   ((or (characterp html-source) (symbolp html-source) (integerp html-source))
-    (list html-source))
-   ((consp html-source)
-    (let ((tag (first html-source))
-          (contents (rest html-source)))
-      (case tag
-        (:none (mapcan #'(lambda (html-source) (escape-html-source html-source space)) contents))
-        (:nowrap (mapcan #'(lambda (html-source) (escape-html-source html-source 'nbsp)) contents))
-        (:wrap (mapcan #'(lambda (html-source) (escape-html-source html-source 'space)) contents))
-        (t (list (cons tag
-                       (mapcan #'(lambda (html-source) (escape-html-source html-source space)) contents)))))))
-   (t (error "Bad html-source: ~S" html-source))))
-
-
-; Escape all content strings in the html-source, while interpreting :nowrap, :wrap, and :none pseudo-tags.
-(defun escape-html (html-source)
-  (let ((results (escape-html-source html-source 'space)))
-    (assert-true (= (length results) 1))
-    (first results)))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; HTML WRITER
-
-;; <html-source> has one of the following formats:
-;;   <string>                                                  ;String to be printed literally
-;;   <symbol>                                                  ;Named entity
-;;   <integer>                                                 ;Numbered entity
-;;   space                                                     ;Space or newline
-;;   (<tag> <html-source> ... <html-source>)                   ;Tag and its contents
-;;   ((:nest <tag> ... <tag>) <html-source> ... <html-source>) ;Equivalent to (<tag> (... (<tag> <html-source> ... <html-source>)))
-;;
-;; <tag> has one of the following formats:
-;;   <symbol>                                                  ;Tag with no attributes
-;;   (<symbol> <attribute> ... <attribute>)                    ;Tag with attributes
-;;   :nowrap                                                   ;Pseudo-tag indicating that spaces in contents should be non-breaking
-;;   :wrap                                                     ;Pseudo-tag indicating that spaces in contents should be breaking
-;;   :none                                                     ;Pseudo-tag indicating no tag -- the contents should be inlined
-;;
-;; <attribute> has one of the following formats:
-;;   (<symbol> <string>)                                       ;Attribute name and value
-;;   (<symbol>)                                                ;Attribute name with omitted value
-
-
-(defparameter *html-right-margin* 120)
-(defparameter *allow-line-breaks-in-tags* nil) ;Allow line breaks in tags between attributes?
-
-(defvar *current-html-pos*)          ;Number of characters written to the current line of the stream; nil if *current-html-newlines* is nonzero
-(defvar *current-html-pending*)      ;String following a space or newline pending to be printed on the current line or nil if none
-(defvar *current-html-indent*)       ;Indent to use for emit-html-newlines-and-indent calls
-(defvar *current-html-newlines*)     ;Number of consecutive newlines just written to the stream; zero if last character wasn't a newline
-
-
-; Flush *current-html-pending* onto the stream.
-(defun flush-current-html-pending (stream)
-  (when *current-html-pending*
-    (unless (zerop (length *current-html-pending*))
-      (write-char #\space stream)
-      (write-string *current-html-pending* stream)
-      (incf *current-html-pos* (1+ (length *current-html-pending*))))
-    (setq *current-html-pending* nil)))
-
-
-; Emit n-newlines onto the stream and indent the next line by *current-html-indent* spaces.
-(defun emit-html-newlines-and-indent (stream n-newlines)
-  (decf n-newlines *current-html-newlines*)
-  (when (plusp n-newlines)
-    (flush-current-html-pending stream)
-    (dotimes (i n-newlines)
-      (write-char #\newline stream))
-    (incf *current-html-newlines* n-newlines)
-    (setq *current-html-pos* nil)))
-
-
-; Write the string to the stream, observing *current-html-pending* and *current-html-pos*.
-(defun write-html-string (stream html-string)
-  (unless (zerop (length html-string))
-    (unless *current-html-pos*
-      (setq *current-html-newlines* 0)
-      (write-string (make-string *current-html-indent* :initial-element #\space) stream)
-      (setq *current-html-pos* *current-html-indent*))
-    (if *current-html-pending*
-      (progn
-        (setq *current-html-pending* (if (zerop (length *current-html-pending*))
-                                       html-string
-                                       (concatenate 'string *current-html-pending* html-string)))
-        (when (>= (+ *current-html-pos* (length *current-html-pending*)) *html-right-margin*)
-          (write-char #\newline stream)
-          (write-string *current-html-pending* stream)
-          (setq *current-html-pos* (length *current-html-pending*))
-          (setq *current-html-pending* nil)))
-      (progn
-        (write-string html-string stream)
-        (incf *current-html-pos* (length html-string))))))
-
-
-; Return true if the value string contains a character that would require an attribute to be quoted.
-; For convenience, this returns true if value contains a period, even though strictly speaking periods do
-; not force quoting.
-(defun attribute-value-needs-quotes (value)
-  (dotimes (i (length value) nil)
-    (let ((ch (char value i)))
-      (unless (or (char<= #\0 ch #\9) (char<= #\A ch #\Z) (char<= #\a ch #\z) (char= ch #\-))
-        (return t)))))
-
-
-; Emit the html tag with the given tag-symbol (name), attributes, and contents.
-(defun write-html-tag (stream tag-symbol attributes contents)
-  (let ((element (assert-non-null (get tag-symbol 'html-element))))
-    (emit-html-newlines-and-indent stream (html-element-newlines-before element))
-    (write-html-string stream (format nil "<~A" (html-element-name element)))
-    (let ((*current-html-indent* (+ *current-html-indent* (html-element-indent element))))
-      (dolist (attribute attributes)
-        (let ((name (first attribute))
-              (value (second attribute)))
-          (write-html-source stream (if *allow-line-breaks-in-tags* 'space #\space))
-          (write-html-string stream (string-downcase (symbol-name name)))
-          (when value
-            (write-html-string
-             stream
-             (format nil
-                     (if (or (attribute-value-needs-quotes value)
-                             (get name 'quoted-attribute))
-                       "=\"~A\""
-                       "=~A")
-                     value)))))
-      (write-html-string stream ">")
-      (emit-html-newlines-and-indent stream (html-element-newlines-begin element))
-      (dolist (html-source contents)
-        (write-html-source stream html-source)))
-    (unless (html-element-self-closing element)
-      (emit-html-newlines-and-indent stream (html-element-newlines-end element))
-      (write-html-string stream (format nil "</~A>" (html-element-name element))))
-    (emit-html-newlines-and-indent stream (html-element-newlines-after element))))
-
-
-; Write html-source to the character stream.
-(defun write-html-source (stream html-source)
-  (cond
-   ((stringp html-source)
-    (write-html-string stream html-source))
-   ((eq html-source 'space)
-    (when (zerop *current-html-newlines*)
-      (flush-current-html-pending stream)
-      (setq *current-html-pending* "")))
-   ((or (characterp html-source) (symbolp html-source))
-    (let ((entity-name (gethash html-source *html-entities-hash*)))
-      (cond
-       (entity-name
-        (write-html-string stream (format nil "&~A;" entity-name)))
-       ((characterp html-source)
-        (write-html-string stream (string html-source)))
-       (t (error "Bad html-source ~S" html-source)))))
-   ((integerp html-source)
-    (assert-true (and (>= html-source 0) (< html-source 65536)))
-    (write-html-string stream (format nil "&#~D;" html-source)))
-   ((consp html-source)
-    (let ((tag (first html-source))
-          (contents (rest html-source)))
-      (if (consp tag)
-        (write-html-tag stream (first tag) (rest tag) contents)
-        (write-html-tag stream tag nil contents))))
-   (t (error "Bad html-source: ~S" html-source))))
-
-
-; Write the top-level html-source to the character stream.
-(defun write-html (html-source &optional (stream t))
-  (with-standard-io-syntax
-    (let ((*print-readably* nil)
-          (*print-escape* nil)
-          (*print-case* :upcase)
-          (*current-html-pos* nil)
-          (*current-html-pending* nil)
-          (*current-html-indent* 0)
-          (*current-html-newlines* 9999))
-      (write-string "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://www.w3.org/TR/REC-html40/loose.dtd\">" stream)
-      (write-char #\newline stream)
-      (write-html-source stream (escape-html html-source)))))
-
-
-; Write html to the text file with the given name (relative to the
-; local directory).
-(defun write-html-to-local-file (filename html)
-  (with-open-file (stream (filename-to-semantic-engine-pathname filename)
-                          :direction :output
-                          :if-exists :supersede
-                          #+mcl :mac-file-creator #+mcl "MOSS")
-    (write-html html stream)))
-
-
-; Expand the :nest constructs inside html-source.
-(defun unnest-html-source (html-source)
-  (labels
-    ((unnest-tags (tags contents)
-       (assert-true tags)
-       (cons (first tags)
-             (if (endp (rest tags))
-               contents
-               (list (unnest-tags (rest tags) contents))))))
-    (if (consp html-source)
-      (let ((tag (first html-source))
-            (contents (rest html-source)))
-        (if (and (consp tag) (eq (first tag) ':nest))
-          (unnest-html-source (unnest-tags (rest tag) contents))
-          (cons tag (mapcar #'unnest-html-source contents))))
-      html-source)))
-
-
-; Coalesce an A element immediately containing or contained in a SPAN element into one if their attributes
-; are disjoint.  Also coalesce SUB and SUP elements immediately containing SPAN elements into one.
-(defun coalesce-elements (html-source)
-  (if (consp html-source)
-    (let ((tag (first html-source))
-          (contents (mapcar #'coalesce-elements (rest html-source))))
-      (cond
-       ((and (consp tag)
-             (member (first tag) '(a span))
-             contents
-             (null (cdr contents))
-             (consp (car contents))
-             (let ((tag2 (caar contents)))
-               (and (consp tag2)
-                    (member (first tag2) '(a span))
-                    (not (eq tag tag2))
-                    (null (intersection (rest tag) (rest tag2) :key #'car)))))
-        (cons
-         (cons 'a
-               (if (eq (first tag) 'a)
-                 (append (rest tag) (rest (caar contents)))
-                 (append (rest (caar contents)) (rest tag))))
-         (cdar contents)))
-       ((and (member tag '(sub sup))
-             contents
-             (null (cdr contents))
-             (consp (car contents))
-             (consp (caar contents))
-             (eq (caaar contents) 'span))
-        (cons
-         (cons tag (rest (caar contents)))
-         (cdar contents)))
-       (t (cons tag contents))))
-    html-source))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; HTML MAPPINGS
-
-(defparameter *html-definitions*
-  '(((:new-line t) (br))
-    
-    ;Misc.
-    (:spc nbsp)
-    (:tab2 nbsp nbsp)
-    (:tab3 nbsp nbsp nbsp)
-    (:nbhy "-")             ;Non-breaking hyphen
-    
-    ;Symbols (-10 suffix means 10-point, etc.)
-    ((:bullet 1) (:script "document.write(U_bull)"))                    ;#x2022
-    ((:minus 1) "-")
-    ((:not-equal 1) (:script "document.write(U_ne)"))                   ;#x2260
-    ((:less-or-equal 1) (:script "document.write(U_le)"))               ;#x2264
-    ((:greater-or-equal 1) (:script "document.write(U_ge)"))            ;#x2265
-    ((:infinity 1) (:script "document.write(U_infin)"))                 ;#x221E
-    ((:left-single-quote 1) #x2018)
-    ((:right-single-quote 1) #x2019)
-    ((:left-double-quote 1) #x201C)
-    ((:right-double-quote 1) #x201D)
-    ((:left-angle-quote 1) #x00AB)
-    ((:right-angle-quote 1) #x00BB)
-    ((:bottom-10 1) (:script "document.write(U_perp)"))                 ;#x22A5
-    ((:vector-assign-10 1) (:script "document.write(U_larr)"))          ;#x2190
-    ((:up-arrow-10 1) (:script "document.write(U_uarr)"))               ;#x2191
-    ((:function-arrow-10 2) (:script "document.write(U_rarr)"))         ;#x2192
-    ((:cartesian-product-10 2) (:script "document.write(U_times)"))     ;#x00D7
-    ((:identical-10 2) (:script "document.write(U_equiv)"))             ;#x2261
-    ((:circle-plus-10 2) (:script "document.write(U_oplus)"))           ;#x2295
-    ((:empty-10 2) (:script "document.write(U_empty)"))                 ;#x2205
-    ((:intersection-10 1) (:script "document.write(U_cap)"))            ;#x2229
-    ((:union-10 1) (:script "document.write(U_cup)"))                   ;#x222A
-    ((:member-10 2) (:script "document.write(U_isin)"))                 ;#x2208
-    ((:not-member-10 2) (:script "document.write(U_notin)"))            ;#x2209
-    ((:derives-10 2) (:script "document.write(U_rArr)"))                ;#x21D2
-    ((:left-triangle-bracket-10 1) (:script "document.write(U_lang)"))  ;#x2329
-    ((:right-triangle-bracket-10 1) (:script "document.write(U_rang)")) ;#x232A
-    
-    ((:alpha 1) (:script "document.write(U_alpha)"))
-    ((:beta 1) (:script "document.write(U_beta)"))
-    ((:chi 1) (:script "document.write(U_chi)"))
-    ((:delta 1) (:script "document.write(U_delta)"))
-    ((:epsilon 1) (:script "document.write(U_epsilon)"))
-    ((:phi 1) (:script "document.write(U_phi)"))
-    ((:gamma 1) (:script "document.write(U_gamma)"))
-    ((:eta 1) (:script "document.write(U_eta)"))
-    ((:iota 1) (:script "document.write(U_iota)"))
-    ((:kappa 1) (:script "document.write(U_kappa)"))
-    ((:lambda 1) (:script "document.write(U_lambda)"))
-    ((:mu 1) (:script "document.write(U_mu)"))
-    ((:nu 1) (:script "document.write(U_nu)"))
-    ((:omicron 1) (:script "document.write(U_omicron)"))
-    ((:pi 1) (:script "document.write(U_pi)"))
-    ((:theta 1) (:script "document.write(U_theta)"))
-    ((:rho 1) (:script "document.write(U_rho)"))
-    ((:sigma 1) (:script "document.write(U_sigma)"))
-    ((:tau 1) (:script "document.write(U_tau)"))
-    ((:upsilon 1) (:script "document.write(U_upsilon)"))
-    ((:omega 1) (:script "document.write(U_omega)"))
-    ((:xi 1) (:script "document.write(U_xi)"))
-    ((:psi 1) (:script "document.write(U_psi)"))
-    ((:zeta 1) (:script "document.write(U_zeta)"))
-    
-    ;Block Styles
-    (:js2 (div (class "js2")))
-    (:es4 (div (class "es4")))
-    (:body-text p)
-    (:section-heading h2)
-    (:subsection-heading h3)
-    (:grammar-header h4)
-    (:grammar-rule (:nest :nowrap (div (class "grammar-rule"))))
-    (:grammar-lhs (:nest :nowrap (div (class "grammar-lhs"))))
-    (:grammar-lhs-last :grammar-lhs)
-    (:grammar-rhs (:nest :nowrap (div (class "grammar-rhs"))))
-    (:grammar-rhs-last :grammar-rhs)
-    (:grammar-argument (:nest :nowrap (div (class "grammar-argument"))))
-    (:semantics (:nest :nowrap (div (class "semantics"))))
-    (:semantics-next (:nest :nowrap (div (class "semantics-next"))))
-    (:semantic-comment (div (class "semantic-comment")))
-    
-    ;Inline Styles
-    (:script (script (type "text/javascript")))
-    (:symbol (span (class "symbol")))
-    (:character-literal code)
-    (:character-literal-control (span (class "control")))
-    (:terminal (span (class "terminal")))
-    (:terminal-keyword (code (class "terminal-keyword")))
-    (:nonterminal (span (class "nonterminal")))
-    (:nonterminal-attribute (span (class "nonterminal-attribute")))
-    (:nonterminal-argument (span (class "nonterminal-argument")))
-    (:semantic-keyword (span (class "semantic-keyword")))
-    (:type-expression (span (class "type-expression")))
-    (:type-name (span (class "type-name")))
-    (:field-name (span (class "field-name")))
-    (:global-variable (span (class "global-variable")))
-    (:local-variable (span (class "local-variable")))
-    (:action-name (span (class "action-name")))
-    (:text :wrap)
-    
-    ;Specials
-    (:invisible del)
-    ((:but-not 6) (b "except"))
-    ((:begin-negative-lookahead 13) "[lookahead" :not-member-10 "{")
-    ((:end-negative-lookahead 2) "}]")
-    ((:line-break 12) "[line" nbsp "break]")
-    ((:no-line-break 15) "[no" nbsp "line" nbsp "break]")
-    (:subscript sub)
-    (:superscript sup)
-    (:plain-subscript :subscript)
-    ((:action-begin 1) "[")
-    ((:action-end 1) "]")
-    ((:vector-begin 1) (b "["))
-    ((:vector-end 1) (b "]"))
-    ((:empty-vector 2) (b "[]"))
-    ((:vector-construct 1) (b "|"))
-    ((:vector-append 2) :circle-plus-10)
-    ((:tuple-begin 1) (b :left-triangle-bracket-10))
-    ((:tuple-end 1) (b :right-triangle-bracket-10))
-    ((:true 4) (:global-variable "true"))
-    ((:false 5) (:global-variable "false"))
-    ((:unique 6) (:semantic-keyword "unique"))
-    ))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; HTML STREAMS
-
-(defstruct (html-stream (:include markup-stream)
-                        (:constructor allocate-html-stream (env head tail level logical-position enclosing-styles anchors))
-                        (:copier nil)
-                        (:predicate html-stream?))
-  (enclosing-styles nil :type list :read-only t) ;A list of enclosing styles
-  (anchors nil :type list :read-only t))  ;A mutable cons cell for accumulating anchors at the beginning of a paragraph
-;                                         ;or nil if not inside a paragraph.
-
-
-(defmethod print-object ((html-stream html-stream) stream)
-  (print-unreadable-object (html-stream stream :identity t)
-    (write-string "html-stream" stream)))
-
-
-; Make a new, empty, open html-stream with the given definitions for its markup-env.
-(defun make-html-stream (markup-env level logical-position enclosing-styles anchors)
-  (let ((head (list nil)))
-    (allocate-html-stream markup-env head head level logical-position enclosing-styles anchors)))
-
-
-; Make a new, empty, open, top-level html-stream with the given definitions
-; for its markup-env.  If links is true, allow links.
-(defun make-top-level-html-stream (html-definitions links)
-  (let ((head (list nil))
-        (markup-env (make-markup-env links)))
-    (markup-env-define-alist markup-env html-definitions)
-    (allocate-html-stream markup-env head head *markup-stream-top-level* nil nil nil)))
-
-
-; Return the approximate width of the html item; return t if it is a line break.
-; Also allow html tags as long as they do not contain line breaks.
-(defmethod markup-group-width ((html-stream html-stream) item)
-  (if (consp item)
-    (reduce #'+ (rest item) :key #'(lambda (subitem) (markup-group-width html-stream subitem)))
-    (markup-width html-stream item)))
-
-
-; Create a top-level html-stream and call emitter to emit its contents.
-; emitter takes one argument -- an html-stream to which it should emit paragraphs.
-; Return the top-level html-stream.  If links is true, allow links.
-(defun depict-html-top-level (title links emitter)
-  (let ((html-stream (make-top-level-html-stream *html-definitions* links)))
-    (markup-stream-append1 html-stream 'html)
-    (depict-block-style (html-stream 'head)
-      (depict-block-style (html-stream 'title)
-        (markup-stream-append1 html-stream title))
-      (markup-stream-append1 html-stream '((link (rel "stylesheet") (href "../styles.css"))))
-      (markup-stream-append1 html-stream '((script (type "text/javascript") (language "JavaScript1.2") (src "../unicodeCompatibility.js")))))
-    (depict-block-style (html-stream 'body)
-      (funcall emitter html-stream))
-    (let ((links (markup-env-links (html-stream-env html-stream))))
-      (warn-missing-links links))
-    html-stream))
-
-
-; Create a top-level html-stream and call emitter to emit its contents.
-; emitter takes one argument -- an html-stream to which it should emit paragraphs.
-; Write the resulting html to the text file with the given name (relative to the
-; local directory).
-; If links is true, allow links.  If external-link-base is also provided, emit links for
-; predefined items and assume that they are located on the page specified by the
-; external-link-base string.
-(defun depict-html-to-local-file (filename title links emitter &key external-link-base)
-  (let* ((*external-link-base* external-link-base)
-         (top-html-stream (depict-html-top-level title links emitter)))
-    (write-html-to-local-file filename (markup-stream-output top-html-stream)))
-  filename)
-
-
-; Return the markup accumulated in the markup-stream after expanding all of its macros.
-; The markup-stream is closed after this function is called.
-(defmethod markup-stream-output ((html-stream html-stream))
-  (coalesce-elements
-   (unnest-html-source
-    (markup-env-expand (markup-stream-env html-stream) (markup-stream-unexpanded-output html-stream) '(:none :nowrap :wrap :nest)))))
-
-
-
-(defmethod depict-block-style-f ((html-stream html-stream) block-style flatten emitter)
-  (assert-true (<= (markup-stream-level html-stream) *markup-stream-paragraph-level*))
-  (assert-true (symbolp block-style))
-  (if (or (null block-style)
-          (and flatten (member block-style (html-stream-enclosing-styles html-stream))))
-    (funcall emitter html-stream)
-    (let ((inner-html-stream (make-html-stream (markup-stream-env html-stream)
-                                               *markup-stream-paragraph-level*
-                                               nil
-                                               (cons block-style (html-stream-enclosing-styles html-stream))
-                                               nil)))
-      (markup-stream-append1 inner-html-stream block-style)
-      (prog1
-        (funcall emitter inner-html-stream)
-        (let ((inner-output (markup-stream-unexpanded-output inner-html-stream)))
-          (when (or (not flatten) (cdr inner-output))
-            (markup-stream-append1 html-stream inner-output)))))))
-
-
-(defmethod depict-paragraph-f ((html-stream html-stream) paragraph-style emitter)
-  (assert-true (= (markup-stream-level html-stream) *markup-stream-paragraph-level*))
-  (assert-true (and paragraph-style (symbolp paragraph-style)))
-  (let* ((anchors (list 'anchors))
-         (inner-html-stream (make-html-stream (markup-stream-env html-stream)
-                                              *markup-stream-content-level*
-                                              (make-logical-position)
-                                              (cons paragraph-style (html-stream-enclosing-styles html-stream))
-                                              anchors)))
-    (prog1
-      (funcall emitter inner-html-stream)
-      (markup-stream-append1 html-stream (cons paragraph-style
-                                               (nreconc (cdr anchors)
-                                                        (markup-stream-unexpanded-output inner-html-stream)))))))
-
-
-(defmethod depict-char-style-f ((html-stream html-stream) char-style emitter)
-  (assert-true (>= (markup-stream-level html-stream) *markup-stream-content-level*))
-  (if char-style
-    (progn
-      (assert-true (symbolp char-style))
-      (let ((inner-html-stream (make-html-stream (markup-stream-env html-stream)
-                                                 *markup-stream-content-level*
-                                                 (markup-stream-logical-position html-stream)
-                                                 (cons char-style (html-stream-enclosing-styles html-stream))
-                                                 (html-stream-anchors html-stream))))
-        (markup-stream-append1 inner-html-stream char-style)
-        (prog1
-          (funcall emitter inner-html-stream)
-          (markup-stream-append1 html-stream (markup-stream-unexpanded-output inner-html-stream)))))
-    (funcall emitter html-stream)))
-
-
-(defmethod ensure-no-enclosing-style ((html-stream html-stream) style)
-  (when (member style (html-stream-enclosing-styles html-stream))
-    (cerror "Ignore" "Style ~S should not be in effect" style)))
-
-
-(defmethod save-block-style ((html-stream html-stream))
-  (reverse (html-stream-enclosing-styles html-stream)))
-
-
-(defmethod with-saved-block-style-f ((html-stream html-stream) saved-block-style flatten emitter)
-  (assert-true (<= (markup-stream-level html-stream) *markup-stream-paragraph-level*))
-  (if (endp saved-block-style)
-    (funcall emitter html-stream)
-    (depict-block-style-f html-stream (first saved-block-style) flatten
-                          #'(lambda (html-stream)
-                              (with-saved-block-style-f html-stream (rest saved-block-style) flatten emitter)))))
-
-
-(defmethod depict-anchor ((html-stream html-stream) link-prefix link-name duplicate)
-  (assert-true (= (markup-stream-level html-stream) *markup-stream-content-level*))
-  (let* ((links (markup-env-links (html-stream-env html-stream)))
-         (name (record-link-definition links link-prefix link-name duplicate)))
-    (when name
-      (push (list (list 'a (list 'name name))) (cdr (html-stream-anchors html-stream))))))
-
-
-(defmethod depict-link-reference-f ((html-stream html-stream) link-prefix link-name external emitter)
-  (assert-true (= (markup-stream-level html-stream) *markup-stream-content-level*))
-  (let* ((links (markup-env-links (html-stream-env html-stream)))
-         (href (record-link-reference links link-prefix link-name external)))
-    (if href
-      (let ((inner-html-stream (make-html-stream (markup-stream-env html-stream)
-                                                 *markup-stream-content-level*
-                                                 (markup-stream-logical-position html-stream)
-                                                 (html-stream-enclosing-styles html-stream)
-                                                 (html-stream-anchors html-stream))))
-        (markup-stream-append1 inner-html-stream (list 'a (list 'href href)))
-        (prog1
-          (funcall emitter inner-html-stream)
-          (markup-stream-append1 html-stream (markup-stream-unexpanded-output inner-html-stream))))
-      (funcall emitter html-stream))))
-
-
-#|
-(write-html
- '(html
-   (head
-    (:nowrap (title "This is my title!<>")))
-   ((body (atr1 "abc") (beta) (qq))
-    "My page this  is  " (br) (p))))
-|#

mozilla/js2/semantics/JS14/Parser.lisp

@@ -1,400 +0,0 @@
-;;;
-;;; Sample JavaScript 1.x grammar
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-(declaim (optimize (debug 3)))
-
-(progn
-  (defparameter *jw*
-    (generate-world
-     "J"
-     '((grammar code-grammar :lr-1 :program)
-       
-       (%section "Expressions")
-       (grammar-argument :alpha normal initial)
-       (grammar-argument :beta allow-in no-in)
-       
-       (%subsection "Primary Expressions")
-       (production (:primary-expression :alpha) (:simple-expression) primary-expression-simple-expression)
-       (production (:primary-expression normal) (:function-expression) primary-expression-function-expression)
-       (production (:primary-expression normal) (:object-literal) primary-expression-object-literal)
-       
-       (production :simple-expression (this) simple-expression-this)
-       (production :simple-expression (null) simple-expression-null)
-       (production :simple-expression (true) simple-expression-true)
-       (production :simple-expression (false) simple-expression-false)
-       (production :simple-expression ($number) simple-expression-number)
-       (production :simple-expression ($string) simple-expression-string)
-       (production :simple-expression ($identifier) simple-expression-identifier)
-       (production :simple-expression ($regular-expression) simple-expression-regular-expression)
-       (production :simple-expression (:parenthesized-expression) simple-expression-parenthesized-expression)
-       (production :simple-expression (:array-literal) simple-expression-array-literal)
-       
-       (production :parenthesized-expression (\( (:expression normal allow-in) \)) parenthesized-expression-expression)
-       
-       
-       (%subsection "Function Expressions")
-       (production :function-expression (:anonymous-function) function-expression-anonymous-function)
-       (production :function-expression (:named-function) function-expression-named-function)
-       
-       
-       (%subsection "Object Literals")
-       (production :object-literal (\{ \}) object-literal-empty)
-       (production :object-literal (\{ :field-list \}) object-literal-list)
-       
-       (production :field-list (:literal-field) field-list-one)
-       (production :field-list (:field-list \, :literal-field) field-list-more)
-       
-       (production :literal-field ($identifier \: (:assignment-expression normal allow-in)) literal-field-assignment-expression)
-       
-       
-       (%subsection "Array Literals")
-       (production :array-literal ([ ]) array-literal-empty)
-       (production :array-literal ([ :element-list ]) array-literal-list)
-       
-       (production :element-list (:literal-element) element-list-one)
-       (production :element-list (:element-list \, :literal-element) element-list-more)
-       
-       (production :literal-element ((:assignment-expression normal allow-in)) literal-element-assignment-expression)
-       
-       
-       (%subsection "Left-Side Expressions")
-       (production (:left-side-expression :alpha) ((:call-expression :alpha)) left-side-expression-call-expression)
-       (production (:left-side-expression :alpha) (:short-new-expression) left-side-expression-short-new-expression)
-       
-       (production (:call-expression :alpha) ((:primary-expression :alpha)) call-expression-primary-expression)
-       (production (:call-expression :alpha) (:full-new-expression) call-expression-full-new-expression)
-       (production (:call-expression :alpha) ((:call-expression :alpha) :member-operator) call-expression-member-operator)
-       (production (:call-expression :alpha) ((:call-expression :alpha) :arguments) call-expression-call)
-       
-       (production :full-new-expression (new :full-new-subexpression :arguments) full-new-expression-new)
-       
-       (production :short-new-expression (new :short-new-subexpression) short-new-expression-new)
-       
-       (production :full-new-subexpression ((:primary-expression normal)) full-new-subexpression-primary-expression)
-       (production :full-new-subexpression (:full-new-expression) full-new-subexpression-full-new-expression)
-       (production :full-new-subexpression (:full-new-subexpression :member-operator) full-new-subexpression-member-operator)
-       
-       (production :short-new-subexpression (:full-new-subexpression) short-new-subexpression-new-full)
-       (production :short-new-subexpression (:short-new-expression) short-new-subexpression-new-short)
-       
-       (production :member-operator ([ (:expression normal allow-in) ]) member-operator-array)
-       (production :member-operator (\. $identifier) member-operator-property)
-       
-       (production :arguments (\( \)) arguments-empty)
-       (production :arguments (\( :argument-list \)) arguments-list)
-       
-       (production :argument-list ((:assignment-expression normal allow-in)) argument-list-one)
-       (production :argument-list (:argument-list \, (:assignment-expression normal allow-in)) argument-list-more)
-       
-       
-       (%subsection "Postfix Operators")
-       (production (:postfix-expression :alpha) ((:left-side-expression :alpha)) postfix-expression-left-side-expression)
-       (production (:postfix-expression :alpha) ((:left-side-expression :alpha) ++) postfix-expression-increment)
-       (production (:postfix-expression :alpha) ((:left-side-expression :alpha) --) postfix-expression-decrement)
-       
-       
-       (%subsection "Unary Operators")
-       (production (:unary-expression :alpha) ((:postfix-expression :alpha)) unary-expression-postfix)
-       (production (:unary-expression :alpha) (delete (:left-side-expression normal)) unary-expression-delete)
-       (production (:unary-expression :alpha) (void (:unary-expression normal)) unary-expression-void)
-       (production (:unary-expression :alpha) (typeof (:unary-expression normal)) unary-expression-typeof)
-       (production (:unary-expression :alpha) (++ (:left-side-expression normal)) unary-expression-increment)
-       (production (:unary-expression :alpha) (-- (:left-side-expression normal)) unary-expression-decrement)
-       (production (:unary-expression :alpha) (+ (:unary-expression normal)) unary-expression-plus)
-       (production (:unary-expression :alpha) (- (:unary-expression normal)) unary-expression-minus)
-       (production (:unary-expression :alpha) (~ (:unary-expression normal)) unary-expression-bitwise-not)
-       (production (:unary-expression :alpha) (! (:unary-expression normal)) unary-expression-logical-not)
-       
-       
-       (%subsection "Multiplicative Operators")
-       (production (:multiplicative-expression :alpha) ((:unary-expression :alpha)) multiplicative-expression-unary)
-       (production (:multiplicative-expression :alpha) ((:multiplicative-expression :alpha) * (:unary-expression normal)) multiplicative-expression-multiply)
-       (production (:multiplicative-expression :alpha) ((:multiplicative-expression :alpha) / (:unary-expression normal)) multiplicative-expression-divide)
-       (production (:multiplicative-expression :alpha) ((:multiplicative-expression :alpha) % (:unary-expression normal)) multiplicative-expression-remainder)
-       
-       
-       (%subsection "Additive Operators")
-       (production (:additive-expression :alpha) ((:multiplicative-expression :alpha)) additive-expression-multiplicative)
-       (production (:additive-expression :alpha) ((:additive-expression :alpha) + (:multiplicative-expression normal)) additive-expression-add)
-       (production (:additive-expression :alpha) ((:additive-expression :alpha) - (:multiplicative-expression normal)) additive-expression-subtract)
-       
-       
-       (%subsection "Bitwise Shift Operators")
-       (production (:shift-expression :alpha) ((:additive-expression :alpha)) shift-expression-additive)
-       (production (:shift-expression :alpha) ((:shift-expression :alpha) << (:additive-expression normal)) shift-expression-left)
-       (production (:shift-expression :alpha) ((:shift-expression :alpha) >> (:additive-expression normal)) shift-expression-right-signed)
-       (production (:shift-expression :alpha) ((:shift-expression :alpha) >>> (:additive-expression normal)) shift-expression-right-unsigned)
-       
-       
-       (%subsection "Relational Operators")
-       (exclude (:relational-expression initial no-in))
-       (production (:relational-expression :alpha :beta) ((:shift-expression :alpha)) relational-expression-shift)
-       (production (:relational-expression :alpha :beta) ((:relational-expression :alpha :beta) < (:shift-expression normal)) relational-expression-less)
-       (production (:relational-expression :alpha :beta) ((:relational-expression :alpha :beta) > (:shift-expression normal)) relational-expression-greater)
-       (production (:relational-expression :alpha :beta) ((:relational-expression :alpha :beta) <= (:shift-expression normal)) relational-expression-less-or-equal)
-       (production (:relational-expression :alpha :beta) ((:relational-expression :alpha :beta) >= (:shift-expression normal)) relational-expression-greater-or-equal)
-       (production (:relational-expression :alpha :beta) ((:relational-expression :alpha :beta) instanceof (:shift-expression normal)) relational-expression-instanceof)
-       (production (:relational-expression :alpha allow-in) ((:relational-expression :alpha allow-in) in (:shift-expression normal)) relational-expression-in)
-       
-       
-       (%subsection "Equality Operators")
-       (exclude (:equality-expression initial no-in))
-       (production (:equality-expression :alpha :beta) ((:relational-expression :alpha :beta)) equality-expression-relational)
-       (production (:equality-expression :alpha :beta) ((:equality-expression :alpha :beta) == (:relational-expression normal :beta)) equality-expression-equal)
-       (production (:equality-expression :alpha :beta) ((:equality-expression :alpha :beta) != (:relational-expression normal :beta)) equality-expression-not-equal)
-       (production (:equality-expression :alpha :beta) ((:equality-expression :alpha :beta) === (:relational-expression normal :beta)) equality-expression-strict-equal)
-       (production (:equality-expression :alpha :beta) ((:equality-expression :alpha :beta) !== (:relational-expression normal :beta)) equality-expression-strict-not-equal)
-       
-       
-       (%subsection "Binary Bitwise Operators")
-       (exclude (:bitwise-and-expression initial no-in))
-       (production (:bitwise-and-expression :alpha :beta) ((:equality-expression :alpha :beta)) bitwise-and-expression-equality)
-       (production (:bitwise-and-expression :alpha :beta) ((:bitwise-and-expression :alpha :beta) & (:equality-expression normal :beta)) bitwise-and-expression-and)
-       
-       (exclude (:bitwise-xor-expression initial no-in))
-       (production (:bitwise-xor-expression :alpha :beta) ((:bitwise-and-expression :alpha :beta)) bitwise-xor-expression-bitwise-and)
-       (production (:bitwise-xor-expression :alpha :beta) ((:bitwise-xor-expression :alpha :beta) ^ (:bitwise-and-expression normal :beta)) bitwise-xor-expression-xor)
-       
-       (exclude (:bitwise-or-expression initial no-in))
-       (production (:bitwise-or-expression :alpha :beta) ((:bitwise-xor-expression :alpha :beta)) bitwise-or-expression-bitwise-xor)
-       (production (:bitwise-or-expression :alpha :beta) ((:bitwise-or-expression :alpha :beta) \| (:bitwise-xor-expression normal :beta)) bitwise-or-expression-or)
-       
-       
-       (%subsection "Binary Logical Operators")
-       (exclude (:logical-and-expression initial no-in))
-       (production (:logical-and-expression :alpha :beta) ((:bitwise-or-expression :alpha :beta)) logical-and-expression-bitwise-or)
-       (production (:logical-and-expression :alpha :beta) ((:logical-and-expression :alpha :beta) && (:bitwise-or-expression normal :beta)) logical-and-expression-and)
-       
-       (exclude (:logical-or-expression initial no-in))
-       (production (:logical-or-expression :alpha :beta) ((:logical-and-expression :alpha :beta)) logical-or-expression-logical-and)
-       (production (:logical-or-expression :alpha :beta) ((:logical-or-expression :alpha :beta) \|\| (:logical-and-expression normal :beta)) logical-or-expression-or)
-       
-       
-       (%subsection "Conditional Operator")
-       (exclude (:conditional-expression initial no-in))
-       (production (:conditional-expression :alpha :beta) ((:logical-or-expression :alpha :beta)) conditional-expression-logical-or)
-       (production (:conditional-expression :alpha :beta) ((:logical-or-expression :alpha :beta) ? (:assignment-expression normal :beta) \: (:assignment-expression normal :beta)) conditional-expression-conditional)
-       
-       
-       (%subsection "Assignment Operators")
-       (exclude (:assignment-expression initial no-in))
-       (production (:assignment-expression :alpha :beta) ((:conditional-expression :alpha :beta)) assignment-expression-conditional)
-       (production (:assignment-expression :alpha :beta) ((:left-side-expression :alpha) = (:assignment-expression normal :beta)) assignment-expression-assignment)
-       (production (:assignment-expression :alpha :beta) ((:left-side-expression :alpha) :compound-assignment (:assignment-expression normal :beta)) assignment-expression-compound)
-       
-       (production :compound-assignment (*=) compound-assignment-multiply)
-       (production :compound-assignment (/=) compound-assignment-divide)
-       (production :compound-assignment (%=) compound-assignment-remainder)
-       (production :compound-assignment (+=) compound-assignment-add)
-       (production :compound-assignment (-=) compound-assignment-subtract)
-       (production :compound-assignment (<<=) compound-assignment-shift-left)
-       (production :compound-assignment (>>=) compound-assignment-shift-right)
-       (production :compound-assignment (>>>=) compound-assignment-shift-right-unsigned)
-       (production :compound-assignment (&=) compound-assignment-and)
-       (production :compound-assignment (^=) compound-assignment-or)
-       (production :compound-assignment (\|=) compound-assignment-xor)
-       
-       
-       (%subsection "Expressions")
-       (exclude (:expression initial no-in))
-       (production (:expression :alpha :beta) ((:assignment-expression :alpha :beta)) expression-assignment)
-       (production (:expression :alpha :beta) ((:expression :alpha :beta) \, (:assignment-expression normal :beta)) expression-comma)
-       
-       (production :optional-expression ((:expression normal allow-in)) optional-expression-expression)
-       (production :optional-expression () optional-expression-empty)
-       
-       
-       (%section "Statements")
-       
-       (grammar-argument :omega
-                         no-short-if ;optional semicolon, but statement must not end with an if without an else
-                         full) ;semicolon required at the end
-       
-       (production (:statement :omega) (:empty-statement) statement-empty-statement)
-       (production (:statement :omega) (:expression-statement :optional-semicolon) statement-expression-statement)
-       (production (:statement :omega) (:variable-definition :optional-semicolon) statement-variable-definition)
-       (production (:statement :omega) (:block) statement-block)
-       (production (:statement :omega) ((:labeled-statement :omega)) statement-labeled-statement)
-       (production (:statement :omega) ((:if-statement :omega)) statement-if-statement)
-       (production (:statement :omega) (:switch-statement) statement-switch-statement)
-       (production (:statement :omega) (:do-statement :optional-semicolon) statement-do-statement)
-       (production (:statement :omega) ((:while-statement :omega)) statement-while-statement)
-       (production (:statement :omega) ((:for-statement :omega)) statement-for-statement)
-       (production (:statement :omega) ((:with-statement :omega)) statement-with-statement)
-       (production (:statement :omega) (:continue-statement :optional-semicolon) statement-continue-statement)
-       (production (:statement :omega) (:break-statement :optional-semicolon) statement-break-statement)
-       (production (:statement :omega) (:return-statement :optional-semicolon) statement-return-statement)
-       (production (:statement :omega) (:throw-statement :optional-semicolon) statement-throw-statement)
-       (production (:statement :omega) (:try-statement) statement-try-statement)
-       
-       (production :optional-semicolon (\;) optional-semicolon-semicolon)
-       
-       
-       (%subsection "Empty Statement")
-       (production :empty-statement (\;) empty-statement-semicolon)
-       
-       
-       (%subsection "Expression Statement")
-       (production :expression-statement ((:expression initial allow-in)) expression-statement-expression)
-       
-       
-       (%subsection "Variable Definition")
-       (production :variable-definition (var (:variable-declaration-list allow-in)) variable-definition-declaration)
-       
-       (production (:variable-declaration-list :beta) ((:variable-declaration :beta)) variable-declaration-list-one)
-       (production (:variable-declaration-list :beta) ((:variable-declaration-list :beta) \, (:variable-declaration :beta)) variable-declaration-list-more)
-       
-       (production (:variable-declaration :beta) ($identifier (:variable-initializer :beta)) variable-declaration-initializer)
-       
-       (production (:variable-initializer :beta) () variable-initializer-empty)
-       (production (:variable-initializer :beta) (= (:assignment-expression normal :beta)) variable-initializer-assignment-expression)
-       
-       
-       (%subsection "Block")
-       (production :block ({ :block-statements }) block-block-statements)
-       
-       (production :block-statements () block-statements-one)
-       (production :block-statements (:block-statements-prefix) block-statements-more)
-       
-       (production :block-statements-prefix ((:statement full)) block-statements-prefix-one)
-       (production :block-statements-prefix (:block-statements-prefix (:statement full)) block-statements-prefix-more)
-       
-       
-       (%subsection "Labeled Statements")
-       (production (:labeled-statement :omega) ($identifier \: (:statement :omega)) labeled-statement-label)
-       
-       
-       (%subsection "If Statement")
-       (production (:if-statement full) (if :parenthesized-expression (:statement full)) if-statement-if-then-full)
-       (production (:if-statement :omega) (if :parenthesized-expression (:statement no-short-if)
-                                              else (:statement :omega)) if-statement-if-then-else)
-       
-       
-       (%subsection "Switch Statement")
-       (production :switch-statement (switch :parenthesized-expression { }) switch-statement-empty)
-       (production :switch-statement (switch :parenthesized-expression { :case-groups :last-case-group }) switch-statement-cases)
-       
-       (production :case-groups () case-groups-empty)
-       (production :case-groups (:case-groups :case-group) case-groups-more)
-       
-       (production :case-group (:case-guards :block-statements-prefix) case-group-block-statements-prefix)
-       
-       (production :last-case-group (:case-guards :block-statements) last-case-group-block-statements)
-       
-       (production :case-guards (:case-guard) case-guards-one)
-       (production :case-guards (:case-guards :case-guard) case-guards-more)
-       
-       (production :case-guard (case (:expression normal allow-in) \:) case-guard-case)
-       (production :case-guard (default \:) case-guard-default)
-       
-       
-       (%subsection "Do-While Statement")
-       (production :do-statement (do (:statement full) while :parenthesized-expression) do-statement-do-while)
-       
-       
-       (%subsection "While Statement")
-       (production (:while-statement :omega) (while :parenthesized-expression (:statement :omega)) while-statement-while)
-       
-       
-       (%subsection "For Statements")
-       (production (:for-statement :omega) (for \( :for-initializer \; :optional-expression \; :optional-expression \)
-                                                (:statement :omega)) for-statement-c-style)
-       (production (:for-statement :omega) (for \( :for-in-binding in (:expression normal allow-in) \) (:statement :omega)) for-statement-in)
-       
-       (production :for-initializer () for-initializer-empty)
-       (production :for-initializer ((:expression normal no-in)) for-initializer-expression)
-       (production :for-initializer (var (:variable-declaration-list no-in)) for-initializer-variable-declaration)
-       
-       (production :for-in-binding ((:left-side-expression normal)) for-in-binding-expression)
-       (production :for-in-binding (var (:variable-declaration no-in)) for-in-binding-variable-declaration)
-       
-       
-       (%subsection "With Statement")
-       (production (:with-statement :omega) (with :parenthesized-expression (:statement :omega)) with-statement-with)
-       
-       
-       (%subsection "Continue and Break Statements")
-       (production :continue-statement (continue :optional-label) continue-statement-optional-label)
-       
-       (production :break-statement (break :optional-label) break-statement-optional-label)
-       
-       (production :optional-label () optional-label-default)
-       (production :optional-label ($identifier) optional-label-identifier)
-       
-       
-       (%subsection "Return Statement")
-       (production :return-statement (return :optional-expression) return-statement-optional-expression)
-       
-       
-       (%subsection "Throw Statement")
-       (production :throw-statement (throw (:expression normal allow-in)) throw-statement-throw)
-       
-       
-       (%subsection "Try Statement")
-       (production :try-statement (try :block :catch-clauses) try-statement-catch-clauses)
-       (production :try-statement (try :block :finally-clause) try-statement-finally-clause)
-       (production :try-statement (try :block :catch-clauses :finally-clause) try-statement-catch-clauses-finally-clause)
-       
-       (production :catch-clauses (:catch-clause) catch-clauses-one)
-       (production :catch-clauses (:catch-clauses :catch-clause) catch-clauses-more)
-       
-       (production :catch-clause (catch \( $identifier \) :block) catch-clause-block)
-       
-       (production :finally-clause (finally :block) finally-clause-block)
-       
-       
-       (%subsection "Function Definition")
-       (production :function-definition (:named-function) function-definition-named-function)
-       
-       (production :anonymous-function (function :formal-parameters-and-body) anonymous-function-formal-parameters-and-body)
-       
-       (production :named-function (function $identifier :formal-parameters-and-body) named-function-formal-parameters-and-body)
-       
-       (production :formal-parameters-and-body (\( :formal-parameters \) { :top-statements }) formal-parameters-and-body)
-       
-       (production :formal-parameters () formal-parameters-none)
-       (production :formal-parameters (:formal-parameters-prefix) formal-parameters-some)
-       
-       (production :formal-parameters-prefix (:formal-parameter) formal-parameters-prefix-one)
-       (production :formal-parameters-prefix (:formal-parameters-prefix \, :formal-parameter) formal-parameters-prefix-more)
-       
-       (production :formal-parameter ($identifier) formal-parameter-identifier)
-       
-       
-       (%section "Programs")
-       
-       (production :program (:top-statements) program)
-       
-       (production :top-statements () top-statements-one)
-       (production :top-statements (:top-statements-prefix) top-statements-more)
-       
-       (production :top-statements-prefix (:top-statement) top-statements-prefix-one)
-       (production :top-statements-prefix (:top-statements-prefix :top-statement) top-statements-prefix-more)
-       
-       (production :top-statement ((:statement full)) top-statement-statement)
-       (production :top-statement (:function-definition) top-statement-function-definition)
-       )))
-  
-  (defparameter *jg* (world-grammar *jw* 'code-grammar))
-  (length (grammar-states *jg*)))
-
-
-#|
-(depict-rtf-to-local-file
- "JS14/ParserGrammar.rtf"
- "JavaScript 1.4 Parser Grammar"
- #'(lambda (markup-stream)
-     (depict-world-commands markup-stream *jw* :visible-semantics nil)))
-
-(depict-html-to-local-file
- "JS14/ParserGrammar.html"
- "JavaScript 1.4 Parser Grammar"
- t
- #'(lambda (markup-stream)
-     (depict-world-commands markup-stream *jw* :visible-semantics nil)))
-
-(with-local-output (s "JS14/ParserGrammar.txt") (print-grammar *jg* s))
-|#

mozilla/js2/semantics/JS20/Kernel.lisp

@@ -1,179 +0,0 @@
-
-(defun js-state-transition (action-results)
-  (assert-type action-results (tuple t bool))
-  (values action-results (if (second action-results) '($re) '($non-re))))
-
-(defun js-metaparse (string &key trace)
-  (lexer-metaparse *ll* string :initial-state '($re) :state-transition #'js-state-transition :trace trace))
-
-(defun js-pmetaparse (string &key (stream t) trace)
-  (lexer-pmetaparse *ll* string :initial-state '($re) :state-transition #'js-state-transition :stream stream :trace trace))
-
-
-; Convert the results of the lexer's actions into a token suitable for the parser.
-(defun js-lexer-results-to-token (token-value line-break)
-  (multiple-value-bind (token token-arg)
-                       (ecase (car token-value)
-                         (identifier (values '$identifier (cdr token-value)))
-                         ((keyword punctuator) (values (intern (string-upcase (cdr token-value))) nil))
-                         (number (values '$number (cdr token-value)))
-                         (string (values '$string (cdr token-value)))
-                         (regular-expression (values '$regular-expression (cdr token-value)))
-                         (end (setq line-break nil) *end-marker*))
-    (when line-break
-      (setq token (terminal-lf-terminal token)))
-    (values token token-arg)))
-
-
-; Lex and parse the input-string of tokens to produce a list of action results.
-; If trace is:
-;   nil,         don't print trace information
-;   :code,       print trace information, including action code
-;   :lexer,      print lexer trace information
-;   :lexer-code  print lexer trace information, including action code
-;   other        print trace information
-; Return three values:
-;   the list of action results;
-;   the list of action results' types;
-;   the list of processed tokens.
-(defun js-parse (input-string &key (lexer *ll*) (grammar *jg*) trace)
-  (let ((lexer-classifier (lexer-classifier lexer))
-        (lexer-metagrammar (lexer-metagrammar lexer))
-        (lexer-trace (cdr (assoc trace '((:lexer t) (:lexer-code :code)))))
-        (state-stack (list (grammar-start-state grammar)))
-        (value-stack nil)
-        (type-stack nil)
-        (prev-number-token nil)
-        (input (append (coerce input-string 'list) '($end)))
-        (token nil)
-        (token-arg nil)
-        (token2 nil)
-        (token2-arg nil)
-        (token-history nil))
-    (flet
-      ((get-next-token-value (lexer-state)
-         (multiple-value-bind (results in-rest)
-                              (action-metaparse lexer-metagrammar lexer-classifier (cons lexer-state input) :trace lexer-trace)
-           (assert-true (null (cdr results)))
-           (setq input in-rest)
-           (car results))))
-      
-      (loop
-        (let* ((state (car state-stack))
-               (transition (state-only-transition state)))
-          (unless transition
-            (unless token
-              (if token2
-                (setq token token2
-                      token-arg token2-arg
-                      token2 nil
-                      token2-arg nil)
-                (let* ((lexer-state (cond
-                                     (prev-number-token '$unit)
-                                     ((or (state-transition state '/) (state-transition state '/=)) '$non-re)
-                                     (t '$re)))
-                       (token-value (get-next-token-value lexer-state))
-                       (line-break nil))
-                  (when (eq (car token-value) 'line-break)
-                    (when (eq lexer-state '$unit)
-                      (setq lexer-state '$non-re))
-                    (setq token-value (get-next-token-value lexer-state))
-                    (setq line-break t))
-                  (setq prev-number-token (eq (car token-value) 'number))
-                  (multiple-value-setq (token token-arg) (js-lexer-results-to-token token-value line-break)))))
-            (setq transition (state-transition state token))
-            (unless transition
-              (when (lf-terminal? token)
-                (setq transition (state-transition state '$virtual-semicolon)))
-              (if transition
-                (progn
-                  (when trace
-                    (format *trace-output* "Inserted virtual semicolon~@:_"))
-                  (setq token2 token
-                        token2-arg token-arg
-                        token '$virtual-semicolon
-                        token-arg nil))
-                (error "Parse error on ~S followed by ~S ..." token (coerce (butlast (ldiff input (nthcdr 31 input))) 'string)))))
-          
-          (when trace
-            (format *trace-output* "S~D: ~@_" (state-number state))
-            (print-values (reverse value-stack) (reverse type-stack) *trace-output*)
-            (pprint-newline :mandatory *trace-output*))
-          
-          (ecase (transition-kind transition)
-            (:shift
-             (push (if token-arg (cons token token-arg) token) token-history)
-             (when trace
-               (format *trace-output* "  shift ~W ~W~:@_" token token-arg)
-               (dolist (action-signature (grammar-symbol-signature grammar token))
-                 (push (cdr action-signature) type-stack)))
-             (dolist (action-function-binding (gethash token (grammar-terminal-actions grammar)))
-               (push (funcall (cdr action-function-binding) token-arg) value-stack))
-             (push (transition-state transition) state-stack)
-             (setq token nil))
-            
-            (:reduce
-             (let ((production (transition-production transition)))
-               (when trace
-                 (write-string "  reduce " *trace-output*)
-                 (if (eq trace :code)
-                   (write production :stream *trace-output* :pretty t)
-                   (print-production production *trace-output*))
-                 (pprint-newline :mandatory *trace-output*))
-               (setq state-stack (nthcdr (production-rhs-length production) state-stack)
-                     state (assert-non-null
-                            (cdr (assoc (production-lhs production) (state-gotos (car state-stack)) :test *grammar-symbol-=*)))
-                     value-stack (funcall (production-evaluator production) value-stack))
-               (push state state-stack)
-               (when trace
-                 (setq type-stack (nthcdr (production-n-action-args production) type-stack))
-                 (dolist (action-signature (grammar-symbol-signature grammar (production-lhs production)))
-                   (push (cdr action-signature) type-stack)))))
-            
-            (:accept
-             (when trace
-               (format *trace-output* "  accept~:@_"))
-             (return (values
-                      (nreverse value-stack)
-                      (if trace
-                        (nreverse type-stack)
-                        (grammar-user-start-action-types grammar))
-                      (nreverse token-history)))))
-          (when trace
-            (format *trace-output* "!")))))))
-
-
-; Simple JS2 read-eval-print loop.
-(defun rep ()
-  (loop
-    (let ((s (read-line *terminal-io* t)))
-      (format *terminal-io* "<~S>~%" s)
-      (dolist (r (multiple-value-list (js-parse s)))
-        (write r :stream *terminal-io* :pretty t)
-        (terpri *terminal-io*)))))
-
-
-#|
-(js-parse "1+2*/4*/
-32")
-(js-parse "32+abc//23e-a4*7e-2 3 id4 4ef;")
-
-(js-parse "0x20")
-(js-parse "2b")
-(js-parse " 3.75" :trace t)
-(js-parse "25" :trace :code)
-(js-parse "32+abc//23e-a4*7e-2 3 id4 4ef;")
-(js-parse "32+abc//23e-a4*7e-2 3 id4 4ef;
-")
-(js-parse "32+abc/ /23e-a4*7e-2 3 /*id4 4*-/ef;
-
-fjds*/y//z")
-(js-parse "3a+in'a+b\\147\"de'\"'\"")
-(js-parse "3*/regexp*///x")
-(js-parse "/regexp*///x")
-(js-parse "if \\x69f \\u0069f")
-(js-parse "if \\x69f z\\x20z")
-(js-parse "3lbs,3in,3 in 3_in,3_lbs")
-(js-parse "3a+b in'a+b\\040\\077\\700\\150\\15A\\69\"de'\"'\"")
-|#
-

mozilla/js2/semantics/JS20/Lexer.lisp

@@ -1,567 +0,0 @@
-;;;
-;;; JavaScript 2.0 lexer
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-(progn
-  (defparameter *lw*
-    (generate-world
-     "L"
-     '((lexer code-lexer
-              :lalr-1
-              :$next-input-element
-              ((:unicode-character (% every (:text "Any Unicode character")) () t)
-               (:unicode-initial-alphabetic
-                (% initial-alpha (:text "Any Unicode initial alphabetic character (includes ASCII "
-                                        (:character-literal #\A) :nbhy (:character-literal #\Z) " and "
-                                        (:character-literal #\a) :nbhy (:character-literal #\z) ")"))
-                () t)
-               (:unicode-alphanumeric
-                (% alphanumeric (:text "Any Unicode alphabetic or decimal digit character (includes ASCII "
-                                       (:character-literal #\0) :nbhy (:character-literal #\9) ", "
-                                       (:character-literal #\A) :nbhy (:character-literal #\Z) ", and "
-                                       (:character-literal #\a) :nbhy (:character-literal #\z) ")"))
-                () t)
-               (:white-space-character (++ (#?0009 #?000B #?000C #\space #?00A0)
-                                           (#?2000 #?2001 #?2002 #?2003 #?2004 #?2005 #?2006 #?2007)
-                                           (#?2008 #?2009 #?200A #?200B)
-                                           (#?3000)) ())
-               (:line-terminator (#?000A #?000D #?2028 #?2029) ())
-               (:non-terminator (- :unicode-character :line-terminator)
-                                (($default-action $default-action)))
-               (:non-terminator-or-slash (- :non-terminator (#\/)) ())
-               (:non-terminator-or-asterisk-or-slash (- :non-terminator (#\* #\/)) ())
-               (:initial-identifier-character (+ :unicode-initial-alphabetic (#\$ #\_))
-                                              (($default-action $default-action)))
-               (:continuing-identifier-character (+ :unicode-alphanumeric (#\$ #\_))
-                                                 (($default-action $default-action)))
-               (:a-s-c-i-i-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                                 (($default-action $default-action)
-                                  (decimal-value $digit-value)))
-               (:non-zero-digit (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                                ((decimal-value $digit-value)))
-               (:hex-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\A #\B #\C #\D #\E #\F #\a #\b #\c #\d #\e #\f)
-                           ((hex-value $digit-value)))
-               (:letter-e (#\E #\e) (($default-action $default-action)))
-               (:letter-x (#\X #\x) (($default-action $default-action)))
-               ((:literal-string-char single) (- :unicode-character (+ (#\' #\\) :line-terminator))
-                (($default-action $default-action)))
-               ((:literal-string-char double) (- :unicode-character (+ (#\" #\\) :line-terminator))
-                (($default-action $default-action)))
-               (:identity-escape (- :non-terminator (+ (#\_) :unicode-alphanumeric))
-                                 (($default-action $default-action)))
-               (:ordinary-reg-exp-char (- :non-terminator (#\\ #\/))
-                                       (($default-action $default-action))))
-              (($default-action character nil identity)
-               ($digit-value integer digit-value digit-char-36)))
-       
-       (rule :$next-input-element
-             ((input-element input-element))
-         (production :$next-input-element ($unit (:next-input-element unit)) $next-input-element-unit
-           (input-element (input-element :next-input-element)))
-         (production :$next-input-element ($re (:next-input-element re)) $next-input-element-re
-           (input-element (input-element :next-input-element)))
-         (production :$next-input-element ($non-re (:next-input-element div)) $next-input-element-non-re
-           (input-element (input-element :next-input-element))))
-       
-       (%text nil "The start symbols are: "
-              (:grammar-symbol (:next-input-element unit)) " if the previous input element was a number; "
-              (:grammar-symbol (:next-input-element re)) " if the previous input-element was not a number and a "
-              (:character-literal #\/) " should be interpreted as a regular expression; and "
-              (:grammar-symbol (:next-input-element div)) " if the previous input-element was not a number and a "
-              (:character-literal #\/) " should be interpreted as a division or division-assignment operator.")
-       
-       (deftype semantic-exception (oneof syntax-error))
-       
-       (%section "Unicode Character Classes")
-       (%charclass :unicode-character)
-       (%charclass :unicode-initial-alphabetic)
-       (%charclass :unicode-alphanumeric)
-       (%charclass :white-space-character)
-       (%charclass :line-terminator)
-       (%charclass :a-s-c-i-i-digit)
-       (%print-actions)
-       
-       (%section "Comments")
-       (production :line-comment (#\/ #\/ :line-comment-characters) line-comment)
-       
-       (production :line-comment-characters () line-comment-characters-empty)
-       (production :line-comment-characters (:line-comment-characters :non-terminator) line-comment-characters-chars)
-       
-       (%charclass :non-terminator)
-       
-       (production :single-line-block-comment (#\/ #\* :block-comment-characters #\* #\/) single-line-block-comment)
-       
-       (production :block-comment-characters () block-comment-characters-empty)
-       (production :block-comment-characters (:block-comment-characters :non-terminator-or-slash) block-comment-characters-chars)
-       (production :block-comment-characters (:pre-slash-characters #\/) block-comment-characters-slash)
-       
-       (production :pre-slash-characters () pre-slash-characters-empty)
-       (production :pre-slash-characters (:block-comment-characters :non-terminator-or-asterisk-or-slash) pre-slash-characters-chars)
-       (production :pre-slash-characters (:pre-slash-characters #\/) pre-slash-characters-slash)
-       
-       (%charclass :non-terminator-or-slash)
-       (%charclass :non-terminator-or-asterisk-or-slash)
-       
-       (production :multi-line-block-comment (#\/ #\* :multi-line-block-comment-characters :block-comment-characters #\* #\/) multi-line-block-comment)
-       
-       (production :multi-line-block-comment-characters (:block-comment-characters :line-terminator) multi-line-block-comment-characters-first)
-       (production :multi-line-block-comment-characters (:multi-line-block-comment-characters :block-comment-characters :line-terminator)
-                   multi-line-block-comment-characters-rest)
-       (%print-actions)
-       
-       (%section "White space")
-       
-       (production :white-space () white-space-empty)
-       (production :white-space (:white-space :white-space-character) white-space-character)
-       (production :white-space (:white-space :single-line-block-comment) white-space-single-line-block-comment)
-       
-       (%section "Line breaks")
-       
-       (production :line-break (:line-terminator) line-break-line-terminator)
-       (production :line-break (:line-comment :line-terminator) line-break-line-comment)
-       (production :line-break (:multi-line-block-comment) line-break-multi-line-block-comment)
-       
-       (production :line-breaks (:line-break) line-breaks-first)
-       (production :line-breaks (:line-breaks :white-space :line-break) line-breaks-rest)
-       
-       (%section "Input elements")
-       
-       (grammar-argument :nu re div unit)
-       (grammar-argument :nu_2 re div)
-       
-       (rule (:next-input-element :nu)
-             ((input-element input-element))
-         (production (:next-input-element re) (:white-space (:input-element re)) next-input-element-re
-           (input-element (input-element :input-element)))
-         (production (:next-input-element div) (:white-space (:input-element div)) next-input-element-div
-           (input-element (input-element :input-element)))
-         (production (:next-input-element unit) ((:- :continuing-identifier-character #\\) :white-space (:input-element div)) next-input-element-unit-normal
-           (input-element (input-element :input-element)))
-         (production (:next-input-element unit) ((:- #\_) :identifier-name) next-input-element-unit-name
-           (input-element (oneof string (name :identifier-name))))
-         (production (:next-input-element unit) (#\_ :identifier-name) next-input-element-unit-underscore-name
-           (input-element (oneof string (name :identifier-name)))))
-       
-       (%print-actions)
-       
-       (rule (:input-element :nu_2)
-             ((input-element input-element))
-         (production (:input-element :nu_2) (:line-breaks) input-element-line-breaks
-           (input-element (oneof line-break)))
-         (production (:input-element :nu_2) (:identifier-or-keyword) input-element-identifier-or-keyword
-           (input-element (input-element :identifier-or-keyword)))
-         (production (:input-element :nu_2) (:punctuator) input-element-punctuator
-           (input-element (oneof punctuator (punctuator :punctuator))))
-         (production (:input-element div) (:division-punctuator) input-element-division-punctuator
-           (input-element (oneof punctuator (punctuator :division-punctuator))))
-         (production (:input-element :nu_2) (:numeric-literal) input-element-numeric-literal
-           (input-element (oneof number (float64-value :numeric-literal))))
-         (production (:input-element :nu_2) (:string-literal) input-element-string-literal
-           (input-element (oneof string (string-value :string-literal))))
-         (production (:input-element re) (:reg-exp-literal) input-element-reg-exp-literal
-           (input-element (oneof regular-expression (r-e-value :reg-exp-literal))))
-         (production (:input-element :nu_2) (:end-of-input) input-element-end
-           (input-element (oneof end))))
-       
-       (production :end-of-input ($end) end-of-input-end)
-       (production :end-of-input (:line-comment $end) end-of-input-line-comment)
-       
-       (deftype reg-exp (tuple (re-body string)
-                          (re-flags string)))
-       
-       (deftype quantity (tuple (amount float64)
-                           (unit string)))
-       
-       (deftype input-element (oneof line-break
-                                     (identifier string)
-                                     (keyword string)
-                                     (punctuator string)
-                                     (number float64)
-                                     (string string)
-                                     (regular-expression reg-exp)
-                                     end))
-       (%print-actions)
-       
-       (%section "Keywords and identifiers")
-       
-       (rule :identifier-name
-             ((name string) (contains-escapes boolean))
-         (production :identifier-name (:initial-identifier-character-or-escape) identifier-name-initial
-           (name (vector (character-value :initial-identifier-character-or-escape)))
-           (contains-escapes (contains-escapes :initial-identifier-character-or-escape)))
-         (production :identifier-name (:null-escapes :initial-identifier-character-or-escape) identifier-name-initial-null-escapes
-           (name (vector (character-value :initial-identifier-character-or-escape)))
-           (contains-escapes true))
-         (production :identifier-name (:identifier-name :continuing-identifier-character-or-escape) identifier-name-continuing
-           (name (append (name :identifier-name) (vector (character-value :continuing-identifier-character-or-escape))))
-           (contains-escapes (or (contains-escapes :identifier-name)
-                                 (contains-escapes :continuing-identifier-character-or-escape))))
-         (production :identifier-name (:identifier-name :null-escape) identifier-name-null-escape
-           (name (name :identifier-name))
-           (contains-escapes true)))
-       
-       (production :null-escapes (:null-escape) null-escapes-one)
-       (production :null-escapes (:null-escapes :null-escape) null-escapes-more)
-       
-       (production :null-escape (#\\ #\_) null-escape-underscore)
-       
-       (rule :initial-identifier-character-or-escape
-             ((character-value character) (contains-escapes boolean))
-         (production :initial-identifier-character-or-escape (:initial-identifier-character) initial-identifier-character-or-escape-ordinary
-           (character-value ($default-action :initial-identifier-character))
-           (contains-escapes false))
-         (production :initial-identifier-character-or-escape (#\\ :hex-escape) initial-identifier-character-or-escape-escape
-           (character-value (if (is-initial-identifier-character (character-value :hex-escape))
-                              (character-value :hex-escape)
-                              (throw (oneof syntax-error))))
-           (contains-escapes true)))
-       
-       (%charclass :initial-identifier-character)
-       
-       (rule :continuing-identifier-character-or-escape
-             ((character-value character) (contains-escapes boolean))
-         (production :continuing-identifier-character-or-escape (:continuing-identifier-character) continuing-identifier-character-or-escape-ordinary
-           (character-value ($default-action :continuing-identifier-character))
-           (contains-escapes false))
-         (production :continuing-identifier-character-or-escape (#\\ :hex-escape) continuing-identifier-character-or-escape-escape
-           (character-value (if (is-continuing-identifier-character (character-value :hex-escape))
-                              (character-value :hex-escape)
-                              (throw (oneof syntax-error))))
-           (contains-escapes true)))
-       
-       (%charclass :continuing-identifier-character)
-       (%print-actions)
-       
-       (define reserved-words (vector string)
-         (vector "abstract" "break" "case" "catch" "class" "const" "continue" "debugger" "default" "delete" "do" "else" "enum"
-                 "export" "extends" "false" "final" "finally" "for" "function" "goto" "if" "implements" "import" "in"
-                 "instanceof" "interface" "namespace" "native" "new" "null" "package" "private" "protected" "public" "return" "static" "super"
-                 "switch" "synchronized" "this" "throw" "throws" "transient" "true" "try" "typeof" "use" "var" "volatile" "while" "with"))
-       (define non-reserved-words (vector string)
-         (vector "exclude" "get" "include" "set"))
-       (define keywords (vector string)
-         (append reserved-words non-reserved-words))
-       
-       (define (member (id string) (list (vector string))) boolean
-         (if (empty list)
-           false
-           (if (string= id (nth list 0))
-             true
-             (member id (subseq list 1)))))
-       
-       (rule :identifier-or-keyword
-             ((input-element input-element))
-         (production :identifier-or-keyword (:identifier-name) identifier-or-keyword-identifier-name
-           (input-element (let ((id string (name :identifier-name)))
-                            (if (and (member id keywords) (not (contains-escapes :identifier-name)))
-                              (oneof keyword id)
-                              (oneof identifier id))))))
-       (%print-actions)
-       
-       (%section "Punctuators")
-       
-       (rule :punctuator ((punctuator string))
-         (production :punctuator (#\!) punctuator-not (punctuator "!"))
-         (production :punctuator (#\! #\=) punctuator-not-equal (punctuator "!="))
-         (production :punctuator (#\! #\= #\=) punctuator-not-identical (punctuator "!=="))
-         (production :punctuator (#\#) punctuator-hash (punctuator "#"))
-         (production :punctuator (#\%) punctuator-modulo (punctuator "%"))
-         (production :punctuator (#\% #\=) punctuator-modulo-equals (punctuator "%="))
-         (production :punctuator (#\&) punctuator-and (punctuator "&"))
-         (production :punctuator (#\& #\&) punctuator-logical-and (punctuator "&&"))
-         (production :punctuator (#\& #\& #\=) punctuator-logical-and-equals (punctuator "&&="))
-         (production :punctuator (#\& #\=) punctuator-and-equals (punctuator "&="))
-         (production :punctuator (#\() punctuator-open-parenthesis (punctuator "("))
-         (production :punctuator (#\)) punctuator-close-parenthesis (punctuator ")"))
-         (production :punctuator (#\*) punctuator-times (punctuator "*"))
-         (production :punctuator (#\* #\=) punctuator-times-equals (punctuator "*="))
-         (production :punctuator (#\+) punctuator-plus (punctuator "+"))
-         (production :punctuator (#\+ #\+) punctuator-increment (punctuator "++"))
-         (production :punctuator (#\+ #\=) punctuator-plus-equals (punctuator "+="))
-         (production :punctuator (#\,) punctuator-comma (punctuator ","))
-         (production :punctuator (#\-) punctuator-minus (punctuator "-"))
-         (production :punctuator (#\- #\-) punctuator-decrement (punctuator "--"))
-         (production :punctuator (#\- #\=) punctuator-minus-equals (punctuator "-="))
-         (production :punctuator (#\- #\>) punctuator-arrow (punctuator "->"))
-         (production :punctuator (#\.) punctuator-dot (punctuator "."))
-         (production :punctuator (#\. #\.) punctuator-double-dot (punctuator ".."))
-         (production :punctuator (#\. #\. #\.) punctuator-triple-dot (punctuator "..."))
-         (production :punctuator (#\:) punctuator-colon (punctuator ":"))
-         (production :punctuator (#\: #\:) punctuator-namespace (punctuator "::"))
-         (production :punctuator (#\;) punctuator-semicolon (punctuator ";"))
-         (production :punctuator (#\<) punctuator-less-than (punctuator "<"))
-         (production :punctuator (#\< #\<) punctuator-left-shift (punctuator "<<"))
-         (production :punctuator (#\< #\< #\=) punctuator-left-shift-equals (punctuator "<<="))
-         (production :punctuator (#\< #\=) punctuator-less-than-or-equal (punctuator "<="))
-         (production :punctuator (#\=) punctuator-assignment (punctuator "="))
-         (production :punctuator (#\= #\=) punctuator-equal (punctuator "=="))
-         (production :punctuator (#\= #\= #\=) punctuator-identical (punctuator "==="))
-         (production :punctuator (#\>) punctuator-greater-than (punctuator ">"))
-         (production :punctuator (#\> #\=) punctuator-greater-than-or-equal (punctuator ">="))
-         (production :punctuator (#\> #\>) punctuator-right-shift (punctuator ">>"))
-         (production :punctuator (#\> #\> #\=) punctuator-right-shift-equals (punctuator ">>="))
-         (production :punctuator (#\> #\> #\>) punctuator-logical-right-shift (punctuator ">>>"))
-         (production :punctuator (#\> #\> #\> #\=) punctuator-logical-right-shift-equals (punctuator ">>>="))
-         (production :punctuator (#\?) punctuator-question (punctuator "?"))
-         (production :punctuator (#\@) punctuator-at (punctuator "@"))
-         (production :punctuator (#\[) punctuator-open-bracket (punctuator "["))
-         (production :punctuator (#\]) punctuator-close-bracket (punctuator "]"))
-         (production :punctuator (#\^) punctuator-xor (punctuator "^"))
-         (production :punctuator (#\^ #\=) punctuator-xor-equals (punctuator "^="))
-         (production :punctuator (#\^ #\^) punctuator-logical-xor (punctuator "^^"))
-         (production :punctuator (#\^ #\^ #\=) punctuator-logical-xor-equals (punctuator "^^="))
-         (production :punctuator (#\{) punctuator-open-brace (punctuator "{"))
-         (production :punctuator (#\|) punctuator-or (punctuator "|"))
-         (production :punctuator (#\| #\=) punctuator-or-equals (punctuator "|="))
-         (production :punctuator (#\| #\|) punctuator-logical-or (punctuator "||"))
-         (production :punctuator (#\| #\| #\=) punctuator-logical-or-equals (punctuator "||="))
-         (production :punctuator (#\}) punctuator-close-brace (punctuator "}"))
-         (production :punctuator (#\~) punctuator-complement (punctuator "~")))
-       
-       (rule :division-punctuator ((punctuator string))
-         (production :division-punctuator (#\/ (:- #\/ #\*)) punctuator-divide (punctuator "/"))
-         (production :division-punctuator (#\/ #\=) punctuator-divide-equals (punctuator "/=")))
-       (%print-actions)
-       
-       (%section "Numeric literals")
-       
-       (rule :numeric-literal ((float64-value float64))
-         (production :numeric-literal (:decimal-literal) numeric-literal-decimal
-           (float64-value (rational-to-float64 (rational-value :decimal-literal))))
-         (production :numeric-literal (:hex-integer-literal (:- :hex-digit)) numeric-literal-hex
-           (float64-value (rational-to-float64 (integer-value :hex-integer-literal)))))
-       (%print-actions)
-       
-       (define (expt (base rational) (exponent integer)) rational
-         (if (= exponent 0)
-           1
-           (if (< exponent 0)
-             (rational/ 1 (expt base (neg exponent)))
-             (rational* base (expt base (- exponent 1))))))
-       
-       (rule :decimal-literal ((rational-value rational))
-         (production :decimal-literal (:mantissa) decimal-literal
-           (rational-value (rational-value :mantissa)))
-         (production :decimal-literal (:mantissa :letter-e :signed-integer) decimal-literal-exponent
-           (rational-value (rational* (rational-value :mantissa) (expt 10 (integer-value :signed-integer))))))
-       
-       (%charclass :letter-e)
-       
-       (rule :mantissa ((rational-value rational))
-         (production :mantissa (:decimal-integer-literal) mantissa-integer
-           (rational-value (integer-value :decimal-integer-literal)))
-         (production :mantissa (:decimal-integer-literal #\.) mantissa-integer-dot
-           (rational-value (integer-value :decimal-integer-literal)))
-         (production :mantissa (:decimal-integer-literal #\. :fraction) mantissa-integer-dot-fraction
-           (rational-value (rational+ (integer-value :decimal-integer-literal)
-                                      (rational-value :fraction))))
-         (production :mantissa (#\. :fraction) mantissa-dot-fraction
-           (rational-value (rational-value :fraction))))
-       
-       (rule :decimal-integer-literal ((integer-value integer))
-         (production :decimal-integer-literal (#\0) decimal-integer-literal-0
-           (integer-value 0))
-         (production :decimal-integer-literal (:non-zero-decimal-digits) decimal-integer-literal-nonzero
-           (integer-value (integer-value :non-zero-decimal-digits))))
-       
-       (rule :non-zero-decimal-digits ((integer-value integer))
-         (production :non-zero-decimal-digits (:non-zero-digit) non-zero-decimal-digits-first
-           (integer-value (decimal-value :non-zero-digit)))
-         (production :non-zero-decimal-digits (:non-zero-decimal-digits :a-s-c-i-i-digit) non-zero-decimal-digits-rest
-           (integer-value (+ (* 10 (integer-value :non-zero-decimal-digits)) (decimal-value :a-s-c-i-i-digit)))))
-       
-       (%charclass :non-zero-digit)
-       
-       (rule :fraction ((rational-value rational))
-         (production :fraction (:decimal-digits) fraction-decimal-digits
-           (rational-value (rational/ (integer-value :decimal-digits)
-                                      (expt 10 (n-digits :decimal-digits))))))
-       (%print-actions)
-       
-       (rule :signed-integer ((integer-value integer))
-         (production :signed-integer (:decimal-digits) signed-integer-no-sign
-           (integer-value (integer-value :decimal-digits)))
-         (production :signed-integer (#\+ :decimal-digits) signed-integer-plus
-           (integer-value (integer-value :decimal-digits)))
-         (production :signed-integer (#\- :decimal-digits) signed-integer-minus
-           (integer-value (neg (integer-value :decimal-digits)))))
-       (%print-actions)
-       
-       (rule :decimal-digits
-             ((integer-value integer) (n-digits integer))
-         (production :decimal-digits (:a-s-c-i-i-digit) decimal-digits-first
-           (integer-value (decimal-value :a-s-c-i-i-digit))
-           (n-digits 1))
-         (production :decimal-digits (:decimal-digits :a-s-c-i-i-digit) decimal-digits-rest
-           (integer-value (+ (* 10 (integer-value :decimal-digits)) (decimal-value :a-s-c-i-i-digit)))
-           (n-digits (+ (n-digits :decimal-digits) 1))))
-       (%print-actions)
-       
-       (rule :hex-integer-literal ((integer-value integer))
-         (production :hex-integer-literal (#\0 :letter-x :hex-digit) hex-integer-literal-first
-           (integer-value (hex-value :hex-digit)))
-         (production :hex-integer-literal (:hex-integer-literal :hex-digit) hex-integer-literal-rest
-           (integer-value (+ (* 16 (integer-value :hex-integer-literal)) (hex-value :hex-digit)))))
-       (%charclass :letter-x)
-       (%charclass :hex-digit)
-       (%print-actions)
-       
-       (%section "String literals")
-       
-       (grammar-argument :theta single double)
-       (rule :string-literal ((string-value string))
-         (production :string-literal (#\' (:string-chars single) #\') string-literal-single
-           (string-value (string-value :string-chars)))
-         (production :string-literal (#\" (:string-chars double) #\") string-literal-double
-           (string-value (string-value :string-chars))))
-       (%print-actions)
-       
-       (rule (:string-chars :theta) ((string-value string))
-         (production (:string-chars :theta) () string-chars-none
-           (string-value ""))
-         (production (:string-chars :theta) ((:string-chars :theta) (:string-char :theta)) string-chars-some
-           (string-value (append (string-value :string-chars)
-                                 (vector (character-value :string-char)))))
-         (production (:string-chars :theta) ((:string-chars :theta) :null-escape) string-chars-null-escape
-           (string-value (string-value :string-chars))))
-       
-       (rule (:string-char :theta) ((character-value character))
-         (production (:string-char :theta) ((:literal-string-char :theta)) string-char-literal
-           (character-value ($default-action :literal-string-char)))
-         (production (:string-char :theta) (#\\ :string-escape) string-char-escape
-           (character-value (character-value :string-escape))))
-       
-       (%charclass (:literal-string-char single))
-       (%charclass (:literal-string-char double))
-       (%print-actions)
-       
-       (rule :string-escape ((character-value character))
-         (production :string-escape (:control-escape) string-escape-control
-           (character-value (character-value :control-escape)))
-         (production :string-escape (:zero-escape) string-escape-zero
-           (character-value (character-value :zero-escape)))
-         (production :string-escape (:hex-escape) string-escape-hex
-           (character-value (character-value :hex-escape)))
-         (production :string-escape (:identity-escape) string-escape-non-escape
-           (character-value ($default-action :identity-escape))))
-       (%charclass :identity-escape)
-       (%print-actions)
-       
-       (rule :control-escape ((character-value character))
-         (production :control-escape (#\b) control-escape-backspace (character-value #?0008))
-         (production :control-escape (#\f) control-escape-form-feed (character-value #?000C))
-         (production :control-escape (#\n) control-escape-new-line (character-value #?000A))
-         (production :control-escape (#\r) control-escape-return (character-value #?000D))
-         (production :control-escape (#\t) control-escape-tab (character-value #?0009))
-         (production :control-escape (#\v) control-escape-vertical-tab (character-value #?000B)))
-       (%print-actions)
-       
-       (rule :zero-escape ((character-value character))
-         (production :zero-escape (#\0 (:- :a-s-c-i-i-digit)) zero-escape-zero
-           (character-value #?0000)))
-       (%print-actions)
-       
-       (rule :hex-escape ((character-value character))
-         (production :hex-escape (#\x :hex-digit :hex-digit) hex-escape-2
-           (character-value (code-to-character (+ (* 16 (hex-value :hex-digit 1))
-                                                  (hex-value :hex-digit 2)))))
-         (production :hex-escape (#\u :hex-digit :hex-digit :hex-digit :hex-digit) hex-escape-4
-           (character-value (code-to-character (+ (+ (+ (* 4096 (hex-value :hex-digit 1))
-                                                        (* 256 (hex-value :hex-digit 2)))
-                                                     (* 16 (hex-value :hex-digit 3)))
-                                                  (hex-value :hex-digit 4))))))
-       
-       (%print-actions)
-       
-       (%section "Regular expression literals")
-       
-       (rule :reg-exp-literal ((r-e-value reg-exp))
-         (production :reg-exp-literal (:reg-exp-body :reg-exp-flags) reg-exp-literal
-           (r-e-value (tuple reg-exp (r-e-body :reg-exp-body) (r-e-flags :reg-exp-flags)))))
-       
-       (rule :reg-exp-flags ((r-e-flags string))
-         (production :reg-exp-flags () reg-exp-flags-none
-           (r-e-flags ""))
-         (production :reg-exp-flags (:reg-exp-flags :continuing-identifier-character-or-escape) reg-exp-flags-more
-           (r-e-flags (append (r-e-flags :reg-exp-flags) (vector (character-value :continuing-identifier-character-or-escape)))))
-         (production :reg-exp-flags (:reg-exp-flags :null-escape) reg-exp-flags-null-escape
-           (r-e-flags (r-e-flags :reg-exp-flags))))
-       
-       (rule :reg-exp-body ((r-e-body string))
-         (production :reg-exp-body (#\/ (:- #\*) :reg-exp-chars #\/) reg-exp-body
-           (r-e-body (r-e-body :reg-exp-chars))))
-       
-       (rule :reg-exp-chars ((r-e-body string))
-         (production :reg-exp-chars (:reg-exp-char) reg-exp-chars-one
-           (r-e-body (r-e-body :reg-exp-char)))
-         (production :reg-exp-chars (:reg-exp-chars :reg-exp-char) reg-exp-chars-more
-           (r-e-body (append (r-e-body :reg-exp-chars)
-                             (r-e-body :reg-exp-char)))))
-       
-       (rule :reg-exp-char ((r-e-body string))
-         (production :reg-exp-char (:ordinary-reg-exp-char) reg-exp-char-ordinary
-           (r-e-body (vector ($default-action :ordinary-reg-exp-char))))
-         (production :reg-exp-char (#\\ :non-terminator) reg-exp-char-escape
-           (r-e-body (vector #\\ ($default-action :non-terminator)))))
-       
-       (%charclass :ordinary-reg-exp-char)
-       )))
-  
-  (defparameter *ll* (world-lexer *lw* 'code-lexer))
-  (defparameter *lg* (lexer-grammar *ll*))
-  (set-up-lexer-metagrammar *ll*)
-  (defparameter *lm* (lexer-metagrammar *ll*)))
-
-
-#|
-(depict-rtf-to-local-file
- "JS20/LexerCharClasses.rtf"
- "JavaScript 2 Lexical Character Classes"
- #'(lambda (rtf-stream)
-     (depict-paragraph (rtf-stream ':grammar-header)
-       (depict rtf-stream "Character Classes"))
-     (dolist (charclass (lexer-charclasses *ll*))
-       (depict-charclass rtf-stream charclass))
-     (depict-paragraph (rtf-stream ':grammar-header)
-       (depict rtf-stream "Grammar"))
-     (depict-grammar rtf-stream *lg*)))
-
-(values
-  (depict-rtf-to-local-file
-   "JS20/LexerGrammar.rtf"
-   "JavaScript 2 Lexical Grammar"
-   #'(lambda (rtf-stream)
-       (depict-world-commands rtf-stream *lw* :visible-semantics nil)))
-  (depict-rtf-to-local-file
-   "JS20/LexerSemantics.rtf"
-   "JavaScript 2 Lexical Semantics"
-   #'(lambda (rtf-stream)
-       (depict-world-commands rtf-stream *lw*))))
-
-(values
-  (depict-html-to-local-file
-   "JS20/LexerGrammar.html"
-   "JavaScript 2 Lexical Grammar"
-   t
-   #'(lambda (rtf-stream)
-       (depict-world-commands rtf-stream *lw* :visible-semantics nil))
-   :external-link-base "notation.html")
-  (depict-html-to-local-file
-   "JS20/LexerSemantics.html"
-   "JavaScript 2 Lexical Semantics"
-   t
-   #'(lambda (rtf-stream)
-       (depict-world-commands rtf-stream *lw*))
-   :external-link-base "notation.html"))
-
-(with-local-output (s "JS20/LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s))
-
-(print-illegal-strings m)
-|#
-
-
-#+allegro (clean-grammar *lg*) ;Remove this line if you wish to print the grammar's state tables.
-(length (grammar-states *lg*))

mozilla/js2/semantics/JS20/RegExp.lisp

@@ -1,655 +0,0 @@
-;;;
-;;; JavaScript 2.0 regular expression parser
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-(progn
-  (defparameter *rw*
-    (generate-world
-     "R"
-     '((lexer regexp-lexer
-              :lr-1
-              :regular-expression-pattern
-              ((:unicode-character (% every (:text "Any Unicode character")) () t)
-               (:unicode-alphanumeric
-                (% alphanumeric (:text "Any Unicode alphabetic or decimal digit character (includes ASCII "
-                                       (:character-literal #\0) :nbhy (:character-literal #\9) ", "
-                                       (:character-literal #\A) :nbhy (:character-literal #\Z) ", and "
-                                       (:character-literal #\a) :nbhy (:character-literal #\z) ")"))
-                () t)
-               (:line-terminator (#?000A #?000D #?2028 #?2029) () t)
-               (:decimal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                               (($default-action $default-action)
-                                (decimal-value $digit-value)))
-               (:non-zero-digit (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                                ((decimal-value $digit-value)))
-               (:hex-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\A #\B #\C #\D #\E #\F #\a #\b #\c #\d #\e #\f)
-                           ((hex-value $digit-value)))
-               (:control-letter (++ (#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)
-                                    (#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
-                                (($default-action $default-action)))
-               (:pattern-character (- :unicode-character (#\^ #\$ #\\ #\. #\* #\+ #\? #\( #\) #\[ #\] #\{ #\} #\|))
-                                   (($default-action $default-action)))
-               ((:class-character dash) (- :unicode-character (#\\ #\]))
-                (($default-action $default-action)))
-               ((:class-character no-dash) (- (:class-character dash) (#\-))
-                (($default-action $default-action)))
-               (:identity-escape (- :unicode-character (+ (#\_) :unicode-alphanumeric))
-                                 (($default-action $default-action))))
-              (($default-action character nil identity)
-               ($digit-value integer digit-value digit-char-36)))
-       
-       (deftype semantic-exception (oneof syntax-error))
-       
-       (%section "Unicode Character Classes")
-       (%charclass :unicode-character)
-       (%charclass :unicode-alphanumeric)
-       (%charclass :line-terminator)
-       
-       (define line-terminators (set character) (set-of character #?000A #?000D #?2028 #?2029))
-       (define re-whitespaces (set character) (set-of character #?000C #?000A #?000D #?0009 #?000B #\space))
-       (define re-digits (set character) (set-of-ranges character #\0 #\9))
-       (define re-word-characters (set character) (set-of-ranges character #\0 #\9 #\A #\Z #\a #\z #\_ nil))
-       (%print-actions)
-       
-       
-       (%section "Regular Expression Definitions")
-       (deftype r-e-input (tuple (str string) (ignore-case boolean) (multiline boolean) (span boolean)))
-       (%text :semantics
-         "Field " (:field str r-e-input) " is the input string. "
-         (:field ignore-case r-e-input) ", "
-         (:field multiline r-e-input) ", and "
-         (:field span r-e-input) " are the corresponding regular expression flags.")
-       
-       (deftype r-e-result (oneof (success r-e-match) failure))
-       (deftype r-e-match (tuple (end-index integer)
-                            (captures (vector capture))))
-       (%text :semantics
-         "A " (:type r-e-match) " holds an intermediate state during the pattern-matching process. "
-         (:field end-index r-e-match)
-         " is the index of the next input character to be matched by the next component in a regular expression pattern. "
-         "If we are at the end of the pattern, " (:field end-index r-e-match)
-         " is one plus the index of the last matched input character. "
-         (:field captures r-e-match)
-         " is a zero-based array of the strings captured so far by capturing parentheses.")
-       
-       (deftype capture (oneof (present string)
-                               absent))
-       (deftype continuation (-> (r-e-match) r-e-result))
-       (%text :semantics
-         "A " (:type continuation)
-         " is a function that attempts to match the remaining portion of the pattern against the input string, "
-         "starting at the intermediate state given by its " (:type r-e-match) " argument. "
-         "If a match is possible, it returns a " (:field success r-e-result) " result that contains the final "
-         (:type r-e-match) " state; if no match is possible, it returns a " (:field failure r-e-result) " result.")
-       
-       (deftype matcher (-> (r-e-input r-e-match continuation) r-e-result))
-       (%text :semantics
-         "A " (:type matcher)
-         " is a function that attempts to match a middle portion of the pattern against the input string, "
-         "starting at the intermediate state given by its " (:type r-e-match) " argument. "
-         "Since the remainder of the pattern heavily influences whether (and how) a middle portion will match, we "
-         "must pass in a " (:type continuation) " function that checks whether the rest of the pattern matched. "
-         "If the continuation returns " (:field failure r-e-result) ", the matcher function may call it repeatedly, "
-         "trying various alternatives at pattern choice points.")
-       (%text :semantics
-         "The " (:type r-e-input) " parameter contains the input string and is merely passed down to subroutines.")
-       
-       (deftype matcher-generator (-> (integer) matcher))
-       (%text :semantics
-         "A " (:type matcher-generator)
-         " is a function executed at the time the regular expression is compiled that returns a " (:type matcher) " for a part "
-         "of the pattern. The " (:type integer) " parameter contains the number of capturing left parentheses seen so far in the "
-         "pattern and is used to assign static, consecutive numbers to capturing parentheses.")
-       
-       (define (character-set-matcher (acceptance-set (set character)) (invert boolean)) matcher   ;*********ignore case?
-         (function ((t r-e-input) (x r-e-match) (c continuation))
-           (let ((i integer (& end-index x))
-                 (s string (& str t)))
-             (if (= i (length s))
-               (oneof failure)
-               (if (xor (character-set-member (nth s i) acceptance-set) invert)
-                 (c (tuple r-e-match (+ i 1) (& captures x)))
-                 (oneof failure))))))
-       (%text :semantics
-         (:global character-set-matcher) " returns a " (:type matcher)
-         " that matches a single input string character. If "
-         (:local invert) " is false, the match succeeds if the character is a member of the "
-         (:local acceptance-set) " set of characters (possibly ignoring case). If "
-         (:local invert) " is true, the match succeeds if the character is not a member of the "
-         (:local acceptance-set) " set of characters (possibly ignoring case).")
-       
-       (define (character-matcher (ch character)) matcher
-         (character-set-matcher (set-of character ch) false))
-       (%text :semantics
-         (:global character-matcher) " returns a " (:type matcher)
-         " that matches a single input string character. The match succeeds if the character is the same as "
-         (:local ch) " (possibly ignoring case).")
-       
-       (%print-actions)
-       
-       
-       (%section "Regular Expression Patterns")
-       
-       (rule :regular-expression-pattern ((exec (-> (r-e-input integer) r-e-result)))
-         (production :regular-expression-pattern (:disjunction) regular-expression-pattern-disjunction
-           (exec
-            (let ((match matcher ((gen-matcher :disjunction) 0)))
-              (function ((t r-e-input) (index integer))
-                (match
-                 t
-                 (tuple r-e-match index (fill-capture (count-parens :disjunction)))
-                 success-continuation))))))
-       
-       (%print-actions)
-       (define (success-continuation (x r-e-match)) r-e-result
-         (oneof success x))
-       (define (fill-capture (i integer)) (vector capture)
-         (if (= i 0)
-           (vector-of capture)
-           (append (fill-capture (- i 1)) (vector (oneof absent)))))
-       
-       
-       (%subsection "Disjunctions")
-       
-       (rule :disjunction ((gen-matcher matcher-generator) (count-parens integer))
-         (production :disjunction (:alternative) disjunction-one
-           (gen-matcher (gen-matcher :alternative))
-           (count-parens (count-parens :alternative)))
-         (production :disjunction (:alternative #\| :disjunction) disjunction-more
-           ((gen-matcher (paren-index integer))
-            (let ((match1 matcher ((gen-matcher :alternative) paren-index))
-                  (match2 matcher ((gen-matcher :disjunction) (+ paren-index (count-parens :alternative)))))
-              (function ((t r-e-input) (x r-e-match) (c continuation))
-                (case (match1 t x c)
-                  ((success y r-e-match) (oneof success y))
-                  (failure (match2 t x c))))))
-           (count-parens (+ (count-parens :alternative) (count-parens :disjunction)))))
-       
-       (%print-actions)
-       
-       
-       (%subsection "Alternatives")
-       
-       (rule :alternative ((gen-matcher matcher-generator) (count-parens integer))
-         (production :alternative () alternative-none
-           ((gen-matcher (paren-index integer :unused))
-            (function ((t r-e-input :unused) (x r-e-match) (c continuation))
-              (c x)))
-           (count-parens 0))
-         (production :alternative (:alternative :term) alternative-some
-           ((gen-matcher (paren-index integer))
-            (let ((match1 matcher ((gen-matcher :alternative) paren-index))
-                  (match2 matcher ((gen-matcher :term) (+ paren-index (count-parens :alternative)))))
-              (function ((t r-e-input) (x r-e-match) (c continuation))
-                (let ((d continuation (function ((y r-e-match))
-                                        (match2 t y c))))
-                  (match1 t x d)))))
-           (count-parens (+ (count-parens :alternative) (count-parens :term)))))
-       
-       (%print-actions)
-       
-       
-       (%subsection "Terms")
-       
-       (rule :term ((gen-matcher matcher-generator) (count-parens integer))
-         (production :term (:assertion) term-assertion
-           ((gen-matcher (paren-index integer :unused))
-            (function ((t r-e-input) (x r-e-match) (c continuation))
-              (if ((test-assertion :assertion) t x)
-                (c x)
-                (oneof failure))))
-           (count-parens 0))
-         (production :term (:atom) term-atom
-           (gen-matcher (gen-matcher :atom))
-           (count-parens (count-parens :atom)))
-         (production :term (:atom :quantifier) term-quantified-atom
-           ((gen-matcher (paren-index integer))
-            (let ((match matcher ((gen-matcher :atom) paren-index))
-                  (min integer (minimum :quantifier))
-                  (max limit (maximum :quantifier))
-                  (greedy boolean (greedy :quantifier)))
-              (if (case max
-                    ((finite m integer) (< m min))
-                    (infinite false))
-                (throw (oneof syntax-error))
-                (repeat-matcher match min max greedy paren-index (count-parens :atom)))))
-           (count-parens (count-parens :atom))))
-       
-       (%print-actions)
-       
-       
-       (rule :quantifier ((minimum integer) (maximum limit) (greedy boolean))
-         (production :quantifier (:quantifier-prefix) quantifier-eager
-           (minimum (minimum :quantifier-prefix))
-           (maximum (maximum :quantifier-prefix))
-           (greedy true))
-         (production :quantifier (:quantifier-prefix #\?) quantifier-greedy
-           (minimum (minimum :quantifier-prefix))
-           (maximum (maximum :quantifier-prefix))
-           (greedy false)))
-       
-       (rule :quantifier-prefix ((minimum integer) (maximum limit))
-         (production :quantifier-prefix (#\*) quantifier-prefix-zero-or-more
-           (minimum 0)
-           (maximum (oneof infinite)))
-         (production :quantifier-prefix (#\+) quantifier-prefix-one-or-more
-           (minimum 1)
-           (maximum (oneof infinite)))
-         (production :quantifier-prefix (#\?) quantifier-prefix-zero-or-one
-           (minimum 0)
-           (maximum (oneof finite 1)))
-         (production :quantifier-prefix (#\{ :decimal-digits #\}) quantifier-prefix-repeat
-           (minimum (integer-value :decimal-digits))
-           (maximum (oneof finite (integer-value :decimal-digits))))
-         (production :quantifier-prefix (#\{ :decimal-digits #\, #\}) quantifier-prefix-repeat-or-more
-           (minimum (integer-value :decimal-digits))
-           (maximum (oneof infinite)))
-         (production :quantifier-prefix (#\{ :decimal-digits #\, :decimal-digits #\}) quantifier-prefix-repeat-range
-           (minimum (integer-value :decimal-digits 1))
-           (maximum (oneof finite (integer-value :decimal-digits 2)))))
-       
-       (rule :decimal-digits ((integer-value integer))
-         (production :decimal-digits (:decimal-digit) decimal-digits-first
-           (integer-value (decimal-value :decimal-digit)))
-         (production :decimal-digits (:decimal-digits :decimal-digit) decimal-digits-rest
-           (integer-value (+ (* 10 (integer-value :decimal-digits)) (decimal-value :decimal-digit)))))
-       (%charclass :decimal-digit)
-       
-       
-       (deftype limit (oneof (finite integer) infinite))
-       
-       (define (reset-parens (x r-e-match) (p integer) (n-parens integer)) r-e-match
-         (if (= n-parens 0)
-           x
-           (let ((y r-e-match (tuple r-e-match (& end-index x)
-                                     (set-nth (& captures x) p (oneof absent)))))
-             (reset-parens y (+ p 1) (- n-parens 1)))))
-       
-       (define (repeat-matcher (body matcher) (min integer) (max limit) (greedy boolean) (paren-index integer) (n-body-parens integer)) matcher
-         (function ((t r-e-input) (x r-e-match) (c continuation))
-           (if (case max
-                 ((finite m integer) (= m 0))
-                 (infinite false))
-             (c x)
-             (let ((d continuation (function ((y r-e-match))
-                                     (if (and (= min 0)
-                                              (= (& end-index y) (& end-index x)))
-                                       (oneof failure)
-                                       (let ((new-min integer (if (= min 0) 0 (- min 1)))
-                                             (new-max limit (case max
-                                                              ((finite m integer) (oneof finite (- m 1)))
-                                                              (infinite (oneof infinite)))))
-                                         ((repeat-matcher body new-min new-max greedy paren-index n-body-parens) t y c)))))
-                   (xr r-e-match (reset-parens x paren-index n-body-parens)))
-               (if (/= min 0)
-                 (body t xr d)
-                 (if greedy
-                   (case (body t xr d)
-                     ((success z r-e-match) (oneof success z))
-                     (failure (c x)))
-                   (case (c x)
-                     ((success z r-e-match) (oneof success z))
-                     (failure (body t xr d)))))))))
-       
-       (%print-actions)
-       
-       
-       (%subsection "Assertions")
-       
-       (rule :assertion ((test-assertion (-> (r-e-input r-e-match) boolean)))
-         (production :assertion (#\^) assertion-beginning
-           ((test-assertion (t r-e-input) (x r-e-match))
-            (if (= (& end-index x) 0)
-              true
-              (and (& multiline t)
-                   (character-set-member (nth (& str t) (- (& end-index x) 1)) line-terminators)))))
-         (production :assertion (#\$) assertion-end
-           ((test-assertion (t r-e-input) (x r-e-match))
-            (if (= (& end-index x) (length (& str t)))
-              true
-              (and (& multiline t)
-                   (character-set-member (nth (& str t) (& end-index x)) line-terminators)))))
-         (production :assertion (#\\ #\b) assertion-word-boundary
-           ((test-assertion (t r-e-input) (x r-e-match))
-            (at-word-boundary (& end-index x) (& str t))))
-         (production :assertion (#\\ #\B) assertion-non-word-boundary
-           ((test-assertion (t r-e-input) (x r-e-match))
-            (not (at-word-boundary (& end-index x) (& str t))))))
-       
-       (%print-actions)
-       
-       (define (at-word-boundary (i integer) (s string)) boolean
-         (xor (in-word (- i 1) s) (in-word i s)))
-       
-       (define (in-word (i integer) (s string)) boolean
-         (if (or (= i -1) (= i (length s)))
-           false
-           (character-set-member (nth s i) re-word-characters)))
-       
-       
-       (%section "Atoms")
-       
-       (rule :atom ((gen-matcher matcher-generator) (count-parens integer))
-         (production :atom (:pattern-character) atom-pattern-character
-           ((gen-matcher (paren-index integer :unused))
-            (character-matcher ($default-action :pattern-character)))
-           (count-parens 0))
-         (production :atom (#\.) atom-dot
-           ((gen-matcher (paren-index integer :unused))
-            (function ((t r-e-input) (x r-e-match) (c continuation))
-              ((character-set-matcher (if (& span t) (set-of character) line-terminators) true) t x c)))
-           (count-parens 0))
-         (production :atom (:null-escape) atom-null-escape
-           ((gen-matcher (paren-index integer :unused))
-            (function ((t r-e-input :unused) (x r-e-match) (c continuation))
-              (c x)))
-           (count-parens 0))
-         (production :atom (#\\ :atom-escape) atom-atom-escape
-           (gen-matcher (gen-matcher :atom-escape))
-           (count-parens 0))
-         (production :atom (:character-class) atom-character-class
-           ((gen-matcher (paren-index integer :unused))
-            (let ((a (set character) (acceptance-set :character-class)))
-              (character-set-matcher a (invert :character-class))))
-           (count-parens 0))
-         (production :atom (#\( :disjunction #\)) atom-parentheses
-           ((gen-matcher (paren-index integer))
-            (let ((match matcher ((gen-matcher :disjunction) (+ paren-index 1))))
-              (function ((t r-e-input) (x r-e-match) (c continuation))
-                (let ((d continuation
-                         (function ((y r-e-match))
-                           (let ((updated-captures (vector capture)
-                                                   (set-nth (& captures y) paren-index
-                                                            (oneof present (subseq (& str t) (& end-index x) (- (& end-index y) 1))))))
-                             (c (tuple r-e-match (& end-index y) updated-captures))))))
-                  (match t x d)))))
-           (count-parens (+ (count-parens :disjunction) 1)))
-         (production :atom (#\( #\? #\: :disjunction #\)) atom-non-capturing-parentheses
-           (gen-matcher (gen-matcher :disjunction))
-           (count-parens (count-parens :disjunction)))
-         (production :atom (#\( #\? #\= :disjunction #\)) atom-positive-lookahead
-           ((gen-matcher (paren-index integer))
-            (let ((match matcher ((gen-matcher :disjunction) paren-index)))
-              (function ((t r-e-input) (x r-e-match) (c continuation))
-                ;(let ((d continuation
-                ;         (function ((y r-e-match))
-                ;           (c (tuple r-e-match (& end-index x) (& captures y))))))
-                ;  (match t x d)))))
-                (case (match t x success-continuation)
-                  ((success y r-e-match)
-                   (c (tuple r-e-match (& end-index x) (& captures y))))
-                  (failure (oneof failure))))))
-           (count-parens (count-parens :disjunction)))
-         (production :atom (#\( #\? #\! :disjunction #\)) atom-negative-lookahead
-           ((gen-matcher (paren-index integer))
-            (let ((match matcher ((gen-matcher :disjunction) paren-index)))
-              (function ((t r-e-input) (x r-e-match) (c continuation))
-                (case (match t x success-continuation)
-                  ((success y r-e-match :unused) (oneof failure))
-                  (failure (c x))))))
-           (count-parens (count-parens :disjunction))))
-       
-       (%charclass :pattern-character)
-       (%print-actions)
-       
-       
-       (%section "Escapes")
-       
-       (production :null-escape (#\\ #\_) null-escape-underscore)
-       
-       (rule :atom-escape ((gen-matcher matcher-generator))
-         (production :atom-escape (:decimal-escape) atom-escape-decimal
-           ((gen-matcher (paren-index integer))
-            (let ((n integer (escape-value :decimal-escape)))
-              (if (= n 0)
-                (character-matcher #?0000)
-                (if (> n paren-index)
-                  (throw (oneof syntax-error))
-                  (backreference-matcher n))))))
-         (production :atom-escape (:character-escape) atom-escape-character
-           ((gen-matcher (paren-index integer :unused))
-            (character-matcher (character-value :character-escape))))
-         (production :atom-escape (:character-class-escape) atom-escape-character-class
-           ((gen-matcher (paren-index integer :unused))
-            (character-set-matcher (acceptance-set :character-class-escape) false))))
-       (%print-actions)
-       
-       (define (backreference-matcher (n integer)) matcher
-         (function ((t r-e-input) (x r-e-match) (c continuation))
-           (case (nth-backreference x n)
-             ((present ref string)
-              (let ((i integer (& end-index x))
-                    (s string (& str t)))
-                (let ((j integer (+ i (length ref))))
-                  (if (> j (length s))
-                    (oneof failure)
-                    (if (string= (subseq s i (- j 1)) ref)   ;*********ignore case?
-                      (c (tuple r-e-match j (& captures x)))
-                      (oneof failure))))))
-             (absent (c x)))))
-       
-       (define (nth-backreference (x r-e-match) (n integer)) capture
-         (nth (& captures x) (- n 1)))
-       
-       
-       (rule :character-escape ((character-value character))
-         (production :character-escape (:control-escape) character-escape-control
-           (character-value (character-value :control-escape)))
-         (production :character-escape (#\c :control-letter) character-escape-control-letter
-           (character-value (code-to-character (bitwise-and (character-to-code ($default-action :control-letter)) 31))))
-         (production :character-escape (:hex-escape) character-escape-hex
-           (character-value (character-value :hex-escape)))
-         (production :character-escape (:identity-escape) character-escape-identity
-           (character-value ($default-action :identity-escape))))
-       
-       (%charclass :control-letter)
-       (%charclass :identity-escape)
-       
-       (rule :control-escape ((character-value character))
-         (production :control-escape (#\f) control-escape-form-feed (character-value #?000C))
-         (production :control-escape (#\n) control-escape-new-line (character-value #?000A))
-         (production :control-escape (#\r) control-escape-return (character-value #?000D))
-         (production :control-escape (#\t) control-escape-tab (character-value #?0009))
-         (production :control-escape (#\v) control-escape-vertical-tab (character-value #?000B)))
-       (%print-actions)
-       
-       
-       (%subsection "Decimal Escapes")
-       
-       (rule :decimal-escape ((escape-value integer))
-         (production :decimal-escape (:decimal-integer-literal (:- :decimal-digit)) decimal-escape-integer
-           (escape-value (integer-value :decimal-integer-literal))))
-       
-       (rule :decimal-integer-literal ((integer-value integer))
-         (production :decimal-integer-literal (#\0) decimal-integer-literal-0
-           (integer-value 0))
-         (production :decimal-integer-literal (:non-zero-decimal-digits) decimal-integer-literal-nonzero
-           (integer-value (integer-value :non-zero-decimal-digits))))
-       
-       (rule :non-zero-decimal-digits ((integer-value integer))
-         (production :non-zero-decimal-digits (:non-zero-digit) non-zero-decimal-digits-first
-           (integer-value (decimal-value :non-zero-digit)))
-         (production :non-zero-decimal-digits (:non-zero-decimal-digits :decimal-digit) non-zero-decimal-digits-rest
-           (integer-value (+ (* 10 (integer-value :non-zero-decimal-digits)) (decimal-value :decimal-digit)))))
-       
-       (%charclass :non-zero-digit)
-       (%print-actions)
-       
-       
-       (%subsection "Hexadecimal Escapes")
-       
-       (rule :hex-escape ((character-value character))
-         (production :hex-escape (#\x :hex-digit :hex-digit) hex-escape-2
-           (character-value (code-to-character (+ (* 16 (hex-value :hex-digit 1))
-                                                  (hex-value :hex-digit 2)))))
-         (production :hex-escape (#\u :hex-digit :hex-digit :hex-digit :hex-digit) hex-escape-4
-           (character-value (code-to-character (+ (+ (+ (* 4096 (hex-value :hex-digit 1))
-                                                        (* 256 (hex-value :hex-digit 2)))
-                                                     (* 16 (hex-value :hex-digit 3)))
-                                                  (hex-value :hex-digit 4))))))
-       (%charclass :hex-digit)
-       (%print-actions)
-       
-       
-       (%subsection "Character Class Escapes")
-       
-       (rule :character-class-escape ((acceptance-set (set character)))
-         (production :character-class-escape (#\s) character-class-escape-whitespace
-           (acceptance-set re-whitespaces))
-         (production :character-class-escape (#\S) character-class-escape-non-whitespace
-           (acceptance-set (character-set-difference (set-of-ranges character #?0000 #?FFFF) re-whitespaces)))
-         (production :character-class-escape (#\d) character-class-escape-digit
-           (acceptance-set re-digits))
-         (production :character-class-escape (#\D) character-class-escape-non-digit
-           (acceptance-set (character-set-difference (set-of-ranges character #?0000 #?FFFF) re-digits)))
-         (production :character-class-escape (#\w) character-class-escape-word
-           (acceptance-set re-word-characters))
-         (production :character-class-escape (#\W) character-class-escape-non-word
-           (acceptance-set (character-set-difference (set-of-ranges character #?0000 #?FFFF) re-word-characters))))
-       (%print-actions)
-       
-       
-       (%section "User-Specified Character Classes")
-       
-       (rule :character-class ((acceptance-set (set character)) (invert boolean))
-         (production :character-class (#\[ (:- #\^) :class-ranges #\]) character-class-positive
-           (acceptance-set (acceptance-set :class-ranges))
-           (invert false))
-         (production :character-class (#\[ #\^ :class-ranges #\]) character-class-negative
-           (acceptance-set (acceptance-set :class-ranges))
-           (invert true)))
-       
-       (rule :class-ranges ((acceptance-set (set character)))
-         (production :class-ranges () class-ranges-none
-           (acceptance-set (set-of character)))
-         (production :class-ranges ((:nonempty-class-ranges dash)) class-ranges-some
-           (acceptance-set (acceptance-set :nonempty-class-ranges))))
-       
-       (grammar-argument :delta dash no-dash)
-       
-       (rule (:nonempty-class-ranges :delta) ((acceptance-set (set character)))
-         (production (:nonempty-class-ranges :delta) ((:class-atom dash)) nonempty-class-ranges-final
-           (acceptance-set (acceptance-set :class-atom)))
-         (production (:nonempty-class-ranges :delta) ((:class-atom :delta) (:nonempty-class-ranges no-dash)) nonempty-class-ranges-non-final
-           (acceptance-set
-            (character-set-union (acceptance-set :class-atom)
-                                 (acceptance-set :nonempty-class-ranges))))
-         (production (:nonempty-class-ranges :delta) ((:class-atom :delta) #\- (:class-atom dash) :class-ranges) nonempty-class-ranges-range
-           (acceptance-set
-            (let ((range (set character) (character-range (acceptance-set :class-atom 1)
-                                                          (acceptance-set :class-atom 2))))
-              (character-set-union range (acceptance-set :class-ranges)))))
-         (production (:nonempty-class-ranges :delta) (:null-escape :class-ranges) nonempty-class-ranges-null-escape
-           (acceptance-set (acceptance-set :class-ranges))))
-       (%print-actions)
-       
-       (define (character-range (low (set character)) (high (set character))) (set character)
-         (if (or (/= (character-set-length low) 1) (/= (character-set-length high) 1))
-           (throw (oneof syntax-error))
-           (let ((l character (character-set-min low))
-                 (h character (character-set-min high)))
-             (if (char<= l h)
-               (set-of-ranges character l h)
-               (throw (oneof syntax-error))))))
-       
-       
-       (%subsection "Character Class Range Atoms")
-       
-       (rule (:class-atom :delta) ((acceptance-set (set character)))
-         (production (:class-atom :delta) ((:class-character :delta)) class-atom-character
-           (acceptance-set (set-of character ($default-action :class-character))))
-         (production (:class-atom :delta) (#\\ :class-escape) class-atom-escape
-           (acceptance-set (acceptance-set :class-escape))))
-       
-       (%charclass (:class-character dash))
-       (%charclass (:class-character no-dash))
-       
-       (rule :class-escape ((acceptance-set (set character)))
-         (production :class-escape (:decimal-escape) class-escape-decimal
-           (acceptance-set
-            (if (= (escape-value :decimal-escape) 0)
-              (set-of character #?0000)
-              (throw (oneof syntax-error)))))
-         (production :class-escape (#\b) class-escape-backspace
-           (acceptance-set (set-of character #?0008)))
-         (production :class-escape (:character-escape) class-escape-character-escape
-           (acceptance-set (set-of character (character-value :character-escape))))
-         (production :class-escape (:character-class-escape) class-escape-character-class-escape
-           (acceptance-set (acceptance-set :character-class-escape))))
-       (%print-actions)
-       )))
-  
-  (defparameter *rl* (world-lexer *rw* 'regexp-lexer))
-  (defparameter *rg* (lexer-grammar *rl*)))
-
-
-(defun run-regexp (regexp input &key ignore-case multiline span)
-  (let ((exec (first (lexer-parse *rl* regexp))))
-    (dotimes (i (length input) '(failure))
-      (let ((result (funcall exec (list input ignore-case multiline span) i)))
-        (ecase (first result)
-          (success
-           (return (list* i (subseq input i (second result)) (cddr result))))
-          (failure))))))
-
-#|
-(values
-  (depict-rtf-to-local-file
-   "JS20/RegExpGrammar.rtf"
-   "Regular Expression Grammar"
-   #'(lambda (rtf-stream)
-       (depict-world-commands rtf-stream *rw* :visible-semantics nil)))
-  (depict-rtf-to-local-file
-   "JS20/RegExpSemantics.rtf"
-   "Regular Expression Semantics"
-   #'(lambda (rtf-stream)
-       (depict-world-commands rtf-stream *rw*))))
-
-(values
-  (depict-html-to-local-file
-   "JS20/RegExpGrammar.html"
-   "Regular Expression Grammar"
-   t
-   #'(lambda (html-stream)
-       (depict-world-commands html-stream *rw* :visible-semantics nil))
-   :external-link-base "notation.html")
-  (depict-html-to-local-file
-   "JS20/RegExpSemantics.html"
-   "Regular Expression Semantics"
-   t
-   #'(lambda (html-stream)
-       (depict-world-commands html-stream *rw*))
-   :external-link-base "notation.html"))
-
-(with-local-output (s "JS20/RegExpGrammar.txt") (print-lexer *rl* s) (print-grammar *rg* s))
-
-(lexer-pparse *rl* "a+" :trace t)
-(lexer-pparse *rl* "[]+" :trace t)
-(run-regexp "(0x|0)2" "0x20")
-(run-regexp "(a*)b\\1+c" "aabaaaac")
-(run-regexp "(a*)b\\1+" "baaaac")
-(run-regexp "b(a+)(a+)?(a+)c" "baaaac")
-(run-regexp "(((a+)?(b+)?c)*)" "aacbbbcac")
-(run-regexp "(\\s\\S\\s)" "aac xa d fds  fds sac")
-(run-regexp "(\\s)" "aac xa deac")
-(run-regexp "[01234]+aa+" "93-43aabbc")
-(run-regexp "[\\101A-ae-]+" "93ABC-@ezy43abc")
-(run-regexp "[\\181A-ae-]+" "93ABC-@ezy43abc")
-(run-regexp "b[ace]+" "baaaacecfe")
-(run-regexp "b[^a]+" "baaaabc")
-(run-regexp "(?=(a+))a*b\\1" "baaabac")
-(run-regexp "(?=(a+))" "baaabac")
-(run-regexp "(.*?)a(?!(a+)b\\2c)\\2(.*)" "baaabaac")
-(run-regexp "(aa|aabaac|ba|b|c)*" "aabaac")
-(run-regexp "[\\_^01234]+\\_aa+" "93-43aabbc")
-(run-regexp "a." "AAab")
-(run-regexp "a." "AAab" :ignore-case t)
-(run-regexp "a.." (concatenate 'string "a" (string #\newline) "bacd"))
-(run-regexp "a.." (concatenate 'string "a" (string #\newline) "bacd") :span t)
-|#
-
-#+allegro (clean-grammar *rg*) ;Remove this line if you wish to print the grammar's state tables.
-(length (grammar-states *rg*))

mozilla/js2/semantics/JS20/Units.lisp

@@ -1,192 +0,0 @@
-;;;
-;;; JavaScript 2.0 lexer
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-(progn
-  (defparameter *uw*
-    (generate-world
-     "U"
-     '((lexer unit-lexer
-              :lalr-1
-              :unit-pattern
-              ((:unicode-initial-alphabetic
-                (% initial-alpha (:text "Any Unicode initial alphabetic character (includes ASCII "
-                                        (:character-literal #\A) :nbhy (:character-literal #\Z) " and "
-                                        (:character-literal #\a) :nbhy (:character-literal #\z) ")"))
-                () t)
-               (:unicode-alphanumeric
-                (% alphanumeric (:text "Any Unicode alphabetic or decimal digit character (includes ASCII "
-                                       (:character-literal #\0) :nbhy (:character-literal #\9) ", "
-                                       (:character-literal #\A) :nbhy (:character-literal #\Z) ", and "
-                                       (:character-literal #\a) :nbhy (:character-literal #\z) ")"))
-                () t)
-               (:white-space-character (++ (#?0009 #?000B #?000C #\space #?00A0)
-                                           (#?2000 #?2001 #?2002 #?2003 #?2004 #?2005 #?2006 #?2007)
-                                           (#?2008 #?2009 #?200A #?200B)
-                                           (#?3000)) ())
-               (:line-terminator (#?000A #?000D #?2028 #?2029) ())
-               (:initial-identifier-character (+ :unicode-initial-alphabetic (#\$ #\_))
-                                              (($default-action $default-action)))
-               (:continuing-identifier-character (+ :unicode-alphanumeric (#\$ #\_))
-                                                 (($default-action $default-action)))
-               (:a-s-c-i-i-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                                 (($default-action $default-action)
-                                  (decimal-value $digit-value))))
-              (($default-action character nil identity)
-               ($digit-value integer digit-value digit-char-36)))
-       
-       
-       (%text nil "The start nonterminal is " (:grammar-symbol :unit-pattern) ".")
-       
-       (deftype semantic-exception (oneof syntax-error))
-       (%print-actions)
-       
-       
-       (%section "White Space")
-       
-       (grammar-argument :sigma wsopt wsreq)
-
-       (%charclass :white-space-character)
-       (%charclass :line-terminator)
-
-       (production :required-white-space (:white-space-character) required-white-space-character)
-       (production :required-white-space (:line-terminator) required-white-space-line-terminator)
-       (production :required-white-space (:required-white-space :white-space-character) required-white-space-more-character)
-       (production :required-white-space (:required-white-space :line-terminator) required-white-space-more-line-terminator)
-
-       (production (:white-space :sigma) (:required-white-space) white-space-required-white-space)
-       (production (:white-space wsopt) () white-space-empty)
-
-       (%section "Unit Patterns")
-
-       (rule :unit-pattern ((value unit-list))
-         (production :unit-pattern ((:white-space wsopt) :unit-quotient) unit-pattern-quotient
-           (value (value :unit-quotient))))
-       
-       (rule :unit-quotient ((value unit-list))
-         (production :unit-quotient ((:unit-product wsopt)) unit-quotient-product
-           (value (value :unit-product)))
-         (production :unit-quotient ((:unit-product wsopt) #\/ (:white-space wsopt) (:unit-product wsopt)) unit-quotient-quotient
-           (value (append (value :unit-product 1) (unit-reciprocal (value :unit-product 2))))))
-       
-       (rule (:unit-product :sigma) ((value unit-list))
-         (production (:unit-product :sigma) ((:unit-factor :sigma)) unit-product-factor
-           (value (value :unit-factor)))
-         (production (:unit-product :sigma) ((:unit-product wsopt) #\* (:white-space wsopt) (:unit-factor :sigma)) unit-product-product
-           (value (append (value :unit-product) (value :unit-factor))))
-         (production (:unit-product :sigma) ((:unit-product wsreq) (:unit-factor :sigma)) unit-product-implied-product
-           (value (append (value :unit-product) (value :unit-factor)))))
-       
-       (rule (:unit-factor :sigma) ((value unit-list))
-         (production (:unit-factor :sigma) (#\1 (:white-space :sigma)) unit-factor-one
-           (value (vector-of unit-factor)))
-         (production (:unit-factor :sigma) (#\1 (:white-space wsopt) #\^ (:white-space wsopt) :signed-integer (:white-space :sigma)) unit-factor-one-exponent
-           (value (vector-of unit-factor)))
-         (production (:unit-factor :sigma) (:identifier (:white-space :sigma)) unit-factor-identifier
-           (value (vector (tuple unit-factor (name :identifier) 1))))
-         (production (:unit-factor :sigma) (:identifier (:white-space wsopt) #\^ (:white-space wsopt) :signed-integer (:white-space :sigma)) unit-factor-identifier-exponent
-           (value (vector (tuple unit-factor (name :identifier) (integer-value :signed-integer))))))
-       
-       (deftype unit-list (vector unit-factor))
-       (deftype unit-factor (tuple (identifier string) (exponent integer)))
-       
-       (define (unit-reciprocal (u unit-list)) unit-list
-         (if (empty u)
-           (vector-of unit-factor)
-           (let ((f unit-factor (nth u 0)))
-             (append (vector (tuple unit-factor (& identifier f) (neg (& exponent f)))) (subseq u 1)))))
-       
-       (%print-actions)
-       
-       
-       (%section "Signed Integers")
-       (rule :signed-integer ((integer-value integer))
-         (production :signed-integer (:decimal-digits) signed-integer-no-sign
-           (integer-value (integer-value :decimal-digits)))
-         (production :signed-integer (#\+ :decimal-digits) signed-integer-plus
-           (integer-value (integer-value :decimal-digits)))
-         (production :signed-integer (#\- :decimal-digits) signed-integer-minus
-           (integer-value (neg (integer-value :decimal-digits)))))
-       
-       (rule :decimal-digits ((integer-value integer))
-         (production :decimal-digits (:a-s-c-i-i-digit) decimal-digits-first
-           (integer-value (decimal-value :a-s-c-i-i-digit)))
-         (production :decimal-digits (:decimal-digits :a-s-c-i-i-digit) decimal-digits-rest
-           (integer-value (+ (* 10 (integer-value :decimal-digits)) (decimal-value :a-s-c-i-i-digit)))))
-       
-       (%charclass :a-s-c-i-i-digit)
-       (%print-actions)
-       
-       
-       (%section "Identifiers")
-       (rule :identifier ((name string))
-         (production :identifier (:initial-identifier-character) identifier-initial
-           (name (vector ($default-action :initial-identifier-character))))
-         (production :identifier (:identifier :continuing-identifier-character) identifier-continuing
-           (name (append (name :identifier) (vector ($default-action :continuing-identifier-character))))))
-       
-       (%charclass :initial-identifier-character)
-       (%charclass :continuing-identifier-character)
-       (%charclass :unicode-initial-alphabetic)
-       (%charclass :unicode-alphanumeric)
-       (%print-actions)
-       )))
-  
-  (defparameter *ul* (world-lexer *uw* 'unit-lexer))
-  (defparameter *ug* (lexer-grammar *ul*))
-  (set-up-lexer-metagrammar *ul*)
-  (defparameter *um* (lexer-metagrammar *ul*)))
-
-
-#|
-(depict-rtf-to-local-file
- "JS20/UnitCharClasses.rtf"
- "JavaScript 2 Unit Character Classes"
- #'(lambda (rtf-stream)
-     (depict-paragraph (rtf-stream ':grammar-header)
-       (depict rtf-stream "Character Classes"))
-     (dolist (charclass (lexer-charclasses *ul*))
-       (depict-charclass rtf-stream charclass))
-     (depict-paragraph (rtf-stream ':grammar-header)
-       (depict rtf-stream "Grammar"))
-     (depict-grammar rtf-stream *ug*)))
-
-(values
-  (depict-rtf-to-local-file
-   "JS20/UnitGrammar.rtf"
-   "JavaScript 2 Unit Grammar"
-   #'(lambda (rtf-stream)
-       (depict-world-commands rtf-stream *uw* :visible-semantics nil)))
-  (depict-rtf-to-local-file
-   "JS20/UnitSemantics.rtf"
-   "JavaScript 2 Unit Semantics"
-   #'(lambda (rtf-stream)
-       (depict-world-commands rtf-stream *uw*))))
-
-(values
-  (depict-html-to-local-file
-   "JS20/UnitGrammar.html"
-   "JavaScript 2 Unit Grammar"
-   t
-   #'(lambda (rtf-stream)
-       (depict-world-commands rtf-stream *uw* :visible-semantics nil))
-   :external-link-base "notation.html")
-  (depict-html-to-local-file
-   "JS20/UnitSemantics.html"
-   "JavaScript 2 Unit Semantics"
-   t
-   #'(lambda (rtf-stream)
-       (depict-world-commands rtf-stream *uw*))
-   :external-link-base "notation.html"))
-
-(with-local-output (s "JS20/UnitGrammar.txt") (print-lexer *ul* s) (print-grammar *ug* s))
-
-(print-illegal-strings m)
-|#
-
-
-#+allegro (clean-grammar *ug*) ;Remove this line if you wish to print the grammar's state tables.
-(length (grammar-states *ug*))

mozilla/js2/semantics/JSECMA/Lexer.lisp

@@ -1,492 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; ECMAScript sample lexer
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-(progn
-  (defparameter *lw*
-    (generate-world
-     "L"
-     '((lexer code-lexer
-              :lalr-1
-              :next-token
-              ((:unicode-character (% every (:text "Any Unicode character")) () t)
-               (:white-space-character (#?0009 #?000B #?000C #\space) ())
-               (:line-terminator (#?000A #?000D) ())
-               (:non-terminator (- :unicode-character :line-terminator) ())
-               (:non-terminator-or-slash (- :non-terminator (#\/)) ())
-               (:non-terminator-or-asterisk-or-slash (- :non-terminator (#\* #\/)) ())
-               (:identifier-letter (++ (#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)
-                                       (#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)
-                                       (#\$ #\_))
-                                   ((character-value character-value)))
-               (:decimal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                               ((character-value character-value)
-                                (decimal-value $digit-value)))
-               (:non-zero-digit (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                                ((decimal-value $digit-value)))
-               (:octal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)
-                             ((character-value character-value)
-                              (octal-value $digit-value)))
-               (:zero-to-three (#\0 #\1 #\2 #\3)
-                               ((octal-value $digit-value)))
-               (:four-to-seven (#\4 #\5 #\6 #\7)
-                               ((octal-value $digit-value)))
-               (:hex-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\A #\B #\C #\D #\E #\F #\a #\b #\c #\d #\e #\f)
-                           ((hex-value $digit-value)))
-               (:exponent-indicator (#\E #\e) ())
-               (:hex-indicator (#\X #\x) ())
-               (:plain-string-char (- :unicode-character (+ (#\' #\" #\\) :octal-digit :line-terminator))
-                                   ((character-value character-value)))
-               (:string-non-escape (- :non-terminator (+ :octal-digit (#\x #\u #\' #\" #\\ #\b #\f #\n #\r #\t #\v)))
-                                   ((character-value character-value))))
-              ((character-value character nil identity)
-               ($digit-value integer digit-value digit-char-36)))
-       
-       (%section "Comments")
-       (production :line-comment (#\/ #\/ :line-comment-characters) line-comment)
-       
-       (production :line-comment-characters () line-comment-characters-empty)
-       (production :line-comment-characters (:line-comment-characters :non-terminator) line-comment-characters-chars)
-       (%charclass :unicode-character)
-       (%charclass :non-terminator)
-       
-       (production :single-line-block-comment (#\/ #\* :block-comment-characters #\* #\/) single-line-block-comment)
-       
-       (production :block-comment-characters () block-comment-characters-empty)
-       (production :block-comment-characters (:block-comment-characters :non-terminator-or-slash) block-comment-characters-chars)
-       (production :block-comment-characters (:pre-slash-characters #\/) block-comment-characters-slash)
-       
-       (production :pre-slash-characters () pre-slash-characters-empty)
-       (production :pre-slash-characters (:block-comment-characters :non-terminator-or-asterisk-or-slash) pre-slash-characters-chars)
-       (production :pre-slash-characters (:pre-slash-characters #\/) pre-slash-characters-slash)
-       
-       (%charclass :non-terminator-or-slash)
-       (%charclass :non-terminator-or-asterisk-or-slash)
-       
-       (production :multi-line-block-comment (#\/ #\* :multi-line-block-comment-characters :block-comment-characters #\* #\/) multi-line-block-comment)
-       
-       (production :multi-line-block-comment-characters (:block-comment-characters :line-terminator) multi-line-block-comment-characters-first)
-       (production :multi-line-block-comment-characters (:multi-line-block-comment-characters :block-comment-characters :line-terminator)
-                   multi-line-block-comment-characters-rest)
-       
-       (%section "White space")
-       
-       (production :white-space () white-space-empty)
-       (production :white-space (:white-space :white-space-character) white-space-character)
-       (production :white-space (:white-space :single-line-block-comment) white-space-single-line-block-comment)
-       (%charclass :white-space-character)
-       
-       (%section "Line breaks")
-       
-       (production :line-break (:line-terminator) line-break-line-terminator)
-       (production :line-break (:line-comment :line-terminator) line-break-line-comment)
-       (production :line-break (:multi-line-block-comment) line-break-multi-line-block-comment)
-       (%charclass :line-terminator)
-       
-       (production :line-breaks (:line-break) line-breaks-first)
-       (production :line-breaks (:line-breaks :white-space :line-break) line-breaks-rest)
-       
-       (%section "Tokens")
-       
-       (declare-action token :next-token token)
-       (production :next-token (:white-space :token) next-token
-         (token (token :token)))
-       
-       (declare-action token :token token)
-       (production :token (:line-breaks) token-line-breaks
-         (token (oneof line-breaks)))
-       (production :token (:identifier-or-reserved-word) token-identifier-or-reserved-word
-         (token (token :identifier-or-reserved-word)))
-       (production :token (:punctuator) token-punctuator
-         (token (oneof punctuator (punctuator :punctuator))))
-       (production :token (:numeric-literal) token-numeric-literal
-         (token (oneof number (float64-value :numeric-literal))))
-       (production :token (:string-literal) token-string-literal
-         (token (oneof string (string-value :string-literal))))
-       (production :token (:end-of-input) token-end
-         (token (oneof end)))
-       
-       (production :end-of-input ($end) end-of-input-end)
-       (production :end-of-input (:line-comment $end) end-of-input-line-comment)
-       
-       (deftype token (oneof (identifier string) (reserved-word string) (punctuator string) (number float64) (string string) line-breaks end))
-       (%print-actions)
-       
-       (%section "Keywords")
-       
-       (declare-action name :identifier-name string)
-       (production :identifier-name (:identifier-letter) identifier-name-letter
-         (name (vector (character-value :identifier-letter))))
-       (production :identifier-name (:identifier-name :identifier-letter) identifier-name-next-letter
-         (name (append (name :identifier-name) (vector (character-value :identifier-letter)))))
-       (production :identifier-name (:identifier-name :decimal-digit) identifier-name-next-digit
-         (name (append (name :identifier-name) (vector (character-value :decimal-digit)))))
-       (%charclass :identifier-letter)
-       (%charclass :decimal-digit)
-       (%print-actions)
-       
-       (define keywords (vector string)
-         (vector "break" "case" "catch" "continue" "default" "delete" "do" "else" "finally" "for" "function" "if" "in"
-                 "new" "return" "switch" "this" "throw" "try" "typeof" "var" "void" "while" "with"))
-       (define future-reserved-words (vector string)
-         (vector "class" "const" "debugger" "enum" "export" "extends" "import" "super"))
-       (define literals (vector string)
-         (vector "null" "true" "false"))
-       (define reserved-words (vector string)
-         (append keywords (append future-reserved-words literals)))
-       
-       (define (member (id string) (list (vector string))) boolean
-         (if (empty list)
-           false
-           (let ((s string (nth list 0)))
-             (if (string= id s)
-               true
-               (member id (subseq list 1))))))
-       
-       (declare-action token :identifier-or-reserved-word token)
-       (production :identifier-or-reserved-word (:identifier-name) identifier-or-reserved-word-identifier-name
-         (token (let ((id string (name :identifier-name)))
-                  (if (member id reserved-words)
-                    (oneof reserved-word id)
-                    (oneof identifier id)))))
-       (%print-actions)
-       
-       (%section "Punctuators")
-       
-       (declare-action punctuator :punctuator string)
-       (production :punctuator (#\=) punctuator-assignment (punctuator "="))
-       (production :punctuator (#\>) punctuator-greater-than (punctuator ">"))
-       (production :punctuator (#\<) punctuator-less-than (punctuator "<"))
-       (production :punctuator (#\= #\=) punctuator-equal (punctuator "=="))
-       (production :punctuator (#\= #\= #\=) punctuator-identical (punctuator "==="))
-       (production :punctuator (#\< #\=) punctuator-less-than-or-equal (punctuator "<="))
-       (production :punctuator (#\> #\=) punctuator-greater-than-or-equal (punctuator ">="))
-       (production :punctuator (#\! #\=) punctuator-not-equal (punctuator "!="))
-       (production :punctuator (#\! #\= #\=) punctuator-not-identical (punctuator "!=="))
-       (production :punctuator (#\,) punctuator-comma (punctuator ","))
-       (production :punctuator (#\!) punctuator-not (punctuator "!"))
-       (production :punctuator (#\~) punctuator-complement (punctuator "~"))
-       (production :punctuator (#\?) punctuator-question (punctuator "?"))
-       (production :punctuator (#\:) punctuator-colon (punctuator ":"))
-       (production :punctuator (#\.) punctuator-period (punctuator "."))
-       (production :punctuator (#\& #\&) punctuator-logical-and (punctuator "&&"))
-       (production :punctuator (#\| #\|) punctuator-logical-or (punctuator "||"))
-       (production :punctuator (#\+ #\+) punctuator-increment (punctuator "++"))
-       (production :punctuator (#\- #\-) punctuator-decrement (punctuator "--"))
-       (production :punctuator (#\+) punctuator-plus (punctuator "+"))
-       (production :punctuator (#\-) punctuator-minus (punctuator "-"))
-       (production :punctuator (#\*) punctuator-times (punctuator "*"))
-       (production :punctuator (#\/) punctuator-divide (punctuator "/"))
-       (production :punctuator (#\&) punctuator-and (punctuator "&"))
-       (production :punctuator (#\|) punctuator-or (punctuator "|"))
-       (production :punctuator (#\^) punctuator-xor (punctuator "^"))
-       (production :punctuator (#\%) punctuator-modulo (punctuator "%"))
-       (production :punctuator (#\< #\<) punctuator-left-shift (punctuator "<<"))
-       (production :punctuator (#\> #\>) punctuator-right-shift (punctuator ">>"))
-       (production :punctuator (#\> #\> #\>) punctuator-logical-right-shift (punctuator ">>>"))
-       (production :punctuator (#\+ #\=) punctuator-plus-equals (punctuator "+="))
-       (production :punctuator (#\- #\=) punctuator-minus-equals (punctuator "-="))
-       (production :punctuator (#\* #\=) punctuator-times-equals (punctuator "*="))
-       (production :punctuator (#\/ #\=) punctuator-divide-equals (punctuator "/="))
-       (production :punctuator (#\& #\=) punctuator-and-equals (punctuator "&="))
-       (production :punctuator (#\| #\=) punctuator-or-equals (punctuator "|="))
-       (production :punctuator (#\^ #\=) punctuator-xor-equals (punctuator "^="))
-       (production :punctuator (#\% #\=) punctuator-modulo-equals (punctuator "%="))
-       (production :punctuator (#\< #\< #\=) punctuator-left-shift-equals (punctuator "<<="))
-       (production :punctuator (#\> #\> #\=) punctuator-right-shift-equals (punctuator ">>="))
-       (production :punctuator (#\> #\> #\> #\=) punctuator-logical-right-shift-equals (punctuator ">>>="))
-       (production :punctuator (#\() punctuator-open-parenthesis (punctuator "("))
-       (production :punctuator (#\)) punctuator-close-parenthesis (punctuator ")"))
-       (production :punctuator (#\{) punctuator-open-brace (punctuator "{"))
-       (production :punctuator (#\}) punctuator-close-brace (punctuator "}"))
-       (production :punctuator (#\[) punctuator-open-bracket (punctuator "["))
-       (production :punctuator (#\]) punctuator-close-bracket (punctuator "]"))
-       (production :punctuator (#\;) punctuator-semicolon (punctuator ";"))
-       (%print-actions)
-       
-       (%section "Numeric literals")
-       
-       (declare-action float64-value :numeric-literal float64)
-       (production :numeric-literal (:decimal-literal) numeric-literal-decimal
-         (float64-value (rational-to-float64 (rational-value :decimal-literal))))
-       (production :numeric-literal (:hex-integer-literal) numeric-literal-hex
-         (float64-value (rational-to-float64 (integer-value :hex-integer-literal))))
-       (production :numeric-literal (:octal-integer-literal) numeric-literal-octal
-         (float64-value (rational-to-float64 (integer-value :octal-integer-literal))))
-       (%print-actions)
-       
-       (define (expt (base rational) (exponent integer)) rational
-         (if (= exponent 0)
-           1
-           (if (< exponent 0)
-             (rational/ 1 (expt base (neg exponent)))
-             (rational* base (expt base (- exponent 1))))))
-       
-       (declare-action rational-value :decimal-literal rational)
-       (production :decimal-literal (:mantissa :exponent) decimal-literal
-         (rational-value (rational* (rational-value :mantissa) (expt 10 (integer-value :exponent)))))
-       
-       (declare-action rational-value :mantissa rational)
-       (production :mantissa (:decimal-integer-literal) mantissa-integer
-         (rational-value (integer-value :decimal-integer-literal)))
-       (production :mantissa (:decimal-integer-literal #\.) mantissa-integer-dot
-         (rational-value (integer-value :decimal-integer-literal)))
-       (production :mantissa (:decimal-integer-literal #\. :fraction) mantissa-integer-dot-fraction
-         (rational-value (rational+ (integer-value :decimal-integer-literal)
-                                    (rational-value :fraction))))
-       (production :mantissa (#\. :fraction) mantissa-dot-fraction
-         (rational-value (rational-value :fraction)))
-       
-       (declare-action integer-value :decimal-integer-literal integer)
-       (production :decimal-integer-literal (#\0) decimal-integer-literal-0
-         (integer-value 0))
-       (production :decimal-integer-literal (:non-zero-decimal-digits) decimal-integer-literal-nonzero
-         (integer-value (integer-value :non-zero-decimal-digits)))
-       
-       (declare-action integer-value :non-zero-decimal-digits integer)
-       (production :non-zero-decimal-digits (:non-zero-digit) non-zero-decimal-digits-first
-         (integer-value (decimal-value :non-zero-digit)))
-       (production :non-zero-decimal-digits (:non-zero-decimal-digits :decimal-digit) non-zero-decimal-digits-rest
-         (integer-value (+ (* 10 (integer-value :non-zero-decimal-digits)) (decimal-value :decimal-digit))))
-       
-       (%charclass :non-zero-digit)
-       
-       (declare-action rational-value :fraction rational)
-       (production :fraction (:decimal-digits) fraction-decimal-digits
-         (rational-value (rational/ (integer-value :decimal-digits)
-                                    (expt 10 (n-digits :decimal-digits)))))
-       (%print-actions)
-       
-       (declare-action integer-value :exponent integer)
-       (production :exponent () exponent-none
-         (integer-value 0))
-       (production :exponent (:exponent-indicator :signed-integer) exponent-integer
-         (integer-value (integer-value :signed-integer)))
-       (%charclass :exponent-indicator)
-       
-       (declare-action integer-value :signed-integer integer)
-       (production :signed-integer (:decimal-digits) signed-integer-no-sign
-         (integer-value (integer-value :decimal-digits)))
-       (production :signed-integer (#\+ :decimal-digits) signed-integer-plus
-         (integer-value (integer-value :decimal-digits)))
-       (production :signed-integer (#\- :decimal-digits) signed-integer-minus
-         (integer-value (neg (integer-value :decimal-digits))))
-       (%print-actions)
-       
-       (declare-action integer-value :decimal-digits integer)
-       (declare-action n-digits :decimal-digits integer)
-       (production :decimal-digits (:decimal-digit) decimal-digits-first
-         (integer-value (decimal-value :decimal-digit))
-         (n-digits 1))
-       (production :decimal-digits (:decimal-digits :decimal-digit) decimal-digits-rest
-         (integer-value (+ (* 10 (integer-value :decimal-digits)) (decimal-value :decimal-digit)))
-         (n-digits (+ (n-digits :decimal-digits) 1)))
-       (%print-actions)
-       
-       (declare-action integer-value :hex-integer-literal integer)
-       (production :hex-integer-literal (#\0 :hex-indicator :hex-digit) hex-integer-literal-first
-         (integer-value (hex-value :hex-digit)))
-       (production :hex-integer-literal (:hex-integer-literal :hex-digit) hex-integer-literal-rest
-         (integer-value (+ (* 16 (integer-value :hex-integer-literal)) (hex-value :hex-digit))))
-       (%charclass :hex-indicator)
-       (%charclass :hex-digit)
-       
-       (declare-action integer-value :octal-integer-literal integer)
-       (production :octal-integer-literal (#\0 :octal-digit) octal-integer-literal-first
-         (integer-value (octal-value :octal-digit)))
-       (production :octal-integer-literal (:octal-integer-literal :octal-digit) octal-integer-literal-rest
-         (integer-value (+ (* 8 (integer-value :octal-integer-literal)) (octal-value :octal-digit))))
-       (%charclass :octal-digit)
-       (%print-actions)
-       
-       (%section "String literals")
-       
-       (grammar-argument :quote single double)
-       (declare-action string-value :string-literal string)
-       (production :string-literal (#\' (:string-chars single) #\') string-literal-single
-         (string-value (string-value :string-chars)))
-       (production :string-literal (#\" (:string-chars double) #\") string-literal-double
-         (string-value (string-value :string-chars)))
-       (%print-actions)
-       
-       (declare-action string-value (:string-chars :quote) string)
-       (production (:string-chars :quote) ((:ordinary-string-chars :quote)) string-chars-ordinary
-         (string-value (string-value :ordinary-string-chars)))
-       (production (:string-chars :quote) ((:string-chars :quote) #\\ :short-octal-escape) string-chars-short-escape
-         (string-value (append (string-value :string-chars)
-                               (vector (character-value :short-octal-escape)))))
-       
-       (declare-action string-value (:ordinary-string-chars :quote) string)
-       (production (:ordinary-string-chars :quote) () ordinary-string-chars-empty
-         (string-value ""))
-       (production (:ordinary-string-chars :quote) ((:string-chars :quote) :plain-string-char) ordinary-string-chars-char
-         (string-value (append (string-value :string-chars)
-                               (vector (character-value :plain-string-char)))))
-       (production (:ordinary-string-chars :quote) ((:string-chars :quote) (:plain-string-quote :quote)) ordinary-string-chars-quote
-         (string-value (append (string-value :string-chars)
-                               (vector (character-value :plain-string-quote)))))
-       (production (:ordinary-string-chars :quote) ((:ordinary-string-chars :quote) :octal-digit) ordinary-string-chars-octal
-         (string-value (append (string-value :ordinary-string-chars)
-                               (vector (character-value :octal-digit)))))
-       (production (:ordinary-string-chars :quote) ((:string-chars :quote) #\\ :ordinary-escape) ordinary-string-chars-escape
-         (string-value (append (string-value :string-chars)
-                               (vector (character-value :ordinary-escape)))))
-       
-       (%charclass :plain-string-char)
-       
-       (declare-action character-value (:plain-string-quote :quote) character)
-       (production (:plain-string-quote single) (#\") plain-string-quote-single
-         (character-value #\"))
-       (production (:plain-string-quote double) (#\') plain-string-quote-double
-         (character-value #\'))
-       (%print-actions)
-       
-       (declare-action character-value :ordinary-escape character)
-       (production :ordinary-escape (:string-char-escape) ordinary-escape-character
-         (character-value (character-value :string-char-escape)))
-       (production :ordinary-escape (:full-octal-escape) ordinary-escape-full-octal
-         (character-value (character-value :full-octal-escape)))
-       (production :ordinary-escape (:hex-escape) ordinary-escape-hex
-         (character-value (character-value :hex-escape)))
-       (production :ordinary-escape (:unicode-escape) ordinary-escape-unicode
-         (character-value (character-value :unicode-escape)))
-       (production :ordinary-escape (:string-non-escape) ordinary-escape-non-escape
-         (character-value (character-value :string-non-escape)))
-       (%charclass :string-non-escape)
-       (%print-actions)
-       
-       (declare-action character-value :string-char-escape character)
-       (production :string-char-escape (#\') string-char-escape-single-quote (character-value #\'))
-       (production :string-char-escape (#\") string-char-escape-double-quote (character-value #\"))
-       (production :string-char-escape (#\\) string-char-escape-backslash (character-value #\\))
-       (production :string-char-escape (#\b) string-char-escape-backspace (character-value #?0008))
-       (production :string-char-escape (#\f) string-char-escape-form-feed (character-value #?000C))
-       (production :string-char-escape (#\n) string-char-escape-new-line (character-value #?000A))
-       (production :string-char-escape (#\r) string-char-escape-return (character-value #?000D))
-       (production :string-char-escape (#\t) string-char-escape-tab (character-value #?0009))
-       (production :string-char-escape (#\v) string-char-escape-vertical-tab (character-value #?000B))
-       (%print-actions)
-       
-       (declare-action character-value :short-octal-escape character)
-       (production :short-octal-escape (:octal-digit) short-octal-escape-1
-         (character-value (code-to-character (octal-value :octal-digit))))
-       (production :short-octal-escape (:zero-to-three :octal-digit) short-octal-escape-2
-         (character-value (code-to-character (+ (* 8 (octal-value :zero-to-three))
-                                                (octal-value :octal-digit)))))
-       
-       (declare-action character-value :full-octal-escape character)
-       (production :full-octal-escape (:four-to-seven :octal-digit) full-octal-escape-2
-         (character-value (code-to-character (+ (* 8 (octal-value :four-to-seven))
-                                                (octal-value :octal-digit)))))
-       (production :full-octal-escape (:zero-to-three :octal-digit :octal-digit) full-octal-escape-3
-         (character-value (code-to-character (+ (+ (* 64 (octal-value :zero-to-three))
-                                                   (* 8 (octal-value :octal-digit 1)))
-                                                (octal-value :octal-digit 2)))))
-       (%charclass :zero-to-three)
-       (%charclass :four-to-seven)
-       
-       (declare-action character-value :hex-escape character)
-       (production :hex-escape (#\x :hex-digit :hex-digit) hex-escape-2
-         (character-value (code-to-character (+ (* 16 (hex-value :hex-digit 1))
-                                                (hex-value :hex-digit 2)))))
-       
-       (declare-action character-value :unicode-escape character)
-       (production :unicode-escape (#\u :hex-digit :hex-digit :hex-digit :hex-digit) unicode-escape-4
-         (character-value (code-to-character (+ (+ (+ (* 4096 (hex-value :hex-digit 1))
-                                                      (* 256 (hex-value :hex-digit 2)))
-                                                   (* 16 (hex-value :hex-digit 3)))
-                                                (hex-value :hex-digit 4)))))
-       (%print-actions)
-       
-       )))
-  
-  (defparameter *ll* (world-lexer *lw* 'code-lexer))
-  (defparameter *lg* (lexer-grammar *ll*))
-  (set-up-lexer-metagrammar *ll*)
-  (defparameter *lm* (lexer-metagrammar *ll*)))
-
-#|
-(depict-rtf-to-local-file
- "JSECMA/LexerCharClasses.rtf"
- "ECMAScript 1 Lexer Character Classes"
- #'(lambda (rtf-stream)
-     (depict-paragraph (rtf-stream ':grammar-header)
-       (depict rtf-stream "Character Classes"))
-     (dolist (charclass (lexer-charclasses *ll*))
-       (depict-charclass rtf-stream charclass))
-     (depict-paragraph (rtf-stream ':grammar-header)
-       (depict rtf-stream "Grammar"))
-     (depict-grammar rtf-stream *lg*)))
-
-(depict-rtf-to-local-file
- "JSECMA/LexerSemantics.rtf"
- "ECMAScript 1 Lexer Semantics"
- #'(lambda (rtf-stream)
-     (depict-world-commands rtf-stream *lw*)))
-
-(depict-html-to-local-file
- "JSECMA/LexerSemantics.html"
- "ECMAScript 1 Lexer Semantics"
- t
- #'(lambda (rtf-stream)
-     (depict-world-commands rtf-stream *lw*)))
-
-(with-local-output (s "JSECMA/LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s))
-
-(print-illegal-strings m)
-
-(lexer-pparse *ll* "0x20")
-(lexer-pparse *ll* "2b")
-(lexer-pparse *ll* " 3.75" :trace t)
-(lexer-pparse *ll* "25" :trace :code)
-(lexer-pmetaparse *ll* "32+abc//23e-a4*7e-2 3 id4 4ef;")
-(lexer-pmetaparse *ll* "32+abc//23e-a4*7e-2 3 id4 4ef;
-")
-(lexer-pmetaparse *ll* "32+abc/ /23e-a4*7e-2 3 /*id4 4*-/ef;
-
-fjds*/y//z")
-(lexer-pmetaparse *ll* "3a+in'a+b\\147\"de'\"'\"")
-|#
-
-
-; Return the ECMAScript input string as a list of tokens like:
-;   (($number . 3.0) + - ++ else ($string . "a+bgde") ($end))
-; Line breaks are removed.
-(defun tokenize (string)
-  (delete
-   '($line-breaks)
-   (mapcar
-    #'(lambda (token-value)
-        (let ((token-value (car token-value)))
-          (ecase (car token-value)
-            (identifier (cons '$identifier (cdr token-value)))
-            ((reserved-word punctuator) (intern (string-upcase (cdr token-value))))
-            (number (cons '$number (cdr token-value)))
-            (string (cons '$string (cdr token-value)))
-            (line-breaks '($line-breaks))
-            (end '($end)))))
-    (lexer-metaparse *ll* string))
-   :test #'equal))
-
-

mozilla/js2/semantics/JSECMA/Parser.lisp

@@ -1,863 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; ECMAScript sample grammar portions
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-(declaim (optimize (debug 3)))
-
-(progn
-  (defparameter *gw*
-    (generate-world
-     "G"
-     '((grammar code-grammar :lr-1 :program)
-       
-       (%section "Types")
-       
-       (deftype value (oneof undefined-value
-                             null-value
-                             (boolean-value boolean)
-                             (number-value float64)
-                             (string-value string)
-                             (object-value object)))
-       (deftype object-or-null (oneof null-object-or-null (object-object-or-null object)))
-       (deftype object (tuple (properties (address (vector property)))
-                         (typeof-name string)
-                         (prototype object-or-null)
-                         (get (-> (prop-name) value-or-exception))
-                         (put (-> (prop-name value) void-or-exception))
-                         (delete (-> (prop-name) boolean-or-exception))
-                         (call (-> (object-or-null (vector value)) reference-or-exception))
-                         (construct (-> ((vector value)) object-or-exception))
-                         (default-value (-> (default-value-hint) value-or-exception))))
-       (deftype default-value-hint (oneof no-hint number-hint string-hint))
-       (deftype property (tuple (name string) (read-only boolean) (enumerable boolean) (permanent boolean) (value (address value))))
-       
-       (deftype prop-name string)
-       (deftype place (tuple (base object) (property prop-name)))
-       (deftype reference (oneof (value-reference value) (place-reference place) (virtual-reference prop-name)))
-       
-       
-       (deftype integer-or-exception (oneof (normal integer) (abrupt exception)))
-       (deftype void-or-exception (oneof normal (abrupt exception)))
-       (deftype boolean-or-exception (oneof (normal boolean) (abrupt exception)))
-       (deftype float64-or-exception (oneof (normal float64) (abrupt exception)))
-       (deftype string-or-exception (oneof (normal string) (abrupt exception)))
-       (deftype object-or-exception (oneof (normal object) (abrupt exception)))
-       (deftype value-or-exception (oneof (normal value) (abrupt exception)))
-       (deftype reference-or-exception (oneof (normal reference) (abrupt exception)))
-       (deftype value-list-or-exception (oneof (normal (vector value)) (abrupt exception)))
-       
-       (%section "Helper Functions")
-       
-       (define (object-or-null-to-value (o object-or-null)) value
-         (case o
-           (null-object-or-null (oneof null-value))
-           ((object-object-or-null obj object) (oneof object-value obj))))
-       
-       (define undefined-result value-or-exception
-         (oneof normal (oneof undefined-value)))
-       (define null-result value-or-exception
-         (oneof normal (oneof null-value)))
-       (define (boolean-result (b boolean)) value-or-exception
-         (oneof normal (oneof boolean-value b)))
-       (define (float64-result (d float64)) value-or-exception
-         (oneof normal (oneof number-value d)))
-       (define (integer-result (i integer)) value-or-exception
-         (float64-result (rational-to-float64 i)))
-       (define (string-result (s string)) value-or-exception
-         (oneof normal (oneof string-value s)))
-       (define (object-result (o object)) value-or-exception
-         (oneof normal (oneof object-value o)))
-       
-       (%section "Exceptions")
-       
-       (deftype exception (oneof (exception value) (error error)))
-       (deftype error (oneof coerce-to-primitive-error
-                             coerce-to-object-error
-                             get-value-error
-                             put-value-error
-                             delete-error))
-       
-       (define (make-error (err error)) exception
-         (oneof error err))
-       
-       (%section "Objects")
-       
-       
-       (%section "Conversions")
-       
-       (define (reference-get-value (rv reference)) value-or-exception
-         (case rv
-           ((value-reference v value) (oneof normal v))
-           ((place-reference r place) ((& get (& base r)) (& property r)))
-           (virtual-reference (typed-oneof value-or-exception abrupt (make-error (oneof get-value-error))))))
-       
-       (define (reference-put-value (rv reference) (v value)) void-or-exception
-         (case rv
-           (value-reference (typed-oneof void-or-exception abrupt (make-error (oneof put-value-error))))
-           ((place-reference r place) ((& put (& base r)) (& property r) v))
-           (virtual-reference (bottom))))
-       
-       (%section "Coercions")
-       
-       (define (coerce-to-boolean (v value)) boolean
-         (case v
-           (((undefined-value null-value)) false)
-           ((boolean-value b boolean) b)
-           ((number-value d float64) (not (or (float64-is-zero d) (float64-is-na-n d))))
-           ((string-value s string) (/= (length s) 0))
-           (object-value true)))
-       
-       (define (coerce-boolean-to-float64 (b boolean)) float64
-         (if b 1.0 0.0))
-       
-       (define (coerce-to-float64 (v value)) float64-or-exception
-         (case v
-           (undefined-value (oneof normal nan))
-           (null-value (oneof normal 0.0))
-           ((boolean-value b boolean) (oneof normal (coerce-boolean-to-float64 b)))
-           ((number-value d float64) (oneof normal d))
-           (string-value (bottom))
-           (object-value (bottom))))
-       
-       (define (float64-to-uint32 (x float64)) integer
-         (if (or (float64-is-na-n x) (float64-is-infinite x))
-           0
-           (mod (truncate-float64 x) #x100000000)))
-       
-       (define (coerce-to-uint32 (v value)) integer-or-exception
-         (letexc (d float64 (coerce-to-float64 v))
-           (oneof normal (float64-to-uint32 d))))
-       
-       (define (coerce-to-int32 (v value)) integer-or-exception
-         (letexc (d float64 (coerce-to-float64 v))
-           (oneof normal (uint32-to-int32 (float64-to-uint32 d)))))
-       
-       (define (uint32-to-int32 (ui integer)) integer
-         (if (< ui #x80000000)
-           ui
-           (- ui #x100000000)))
-       
-       (define (coerce-to-string (v value)) string-or-exception
-         (case v
-           (undefined-value (oneof normal "undefined"))
-           (null-value (oneof normal "null"))
-           ((boolean-value b boolean) (if b (oneof normal "true") (oneof normal "false")))
-           (number-value (bottom))
-           ((string-value s string) (oneof normal s))
-           (object-value (bottom))))
-       
-       (define (coerce-to-primitive (v value) (hint default-value-hint)) value-or-exception
-         (case v
-           (((undefined-value null-value boolean-value number-value string-value)) (oneof normal v))
-           ((object-value o object)
-            (letexc (pv value ((& default-value o) hint))
-              (case pv
-                (((undefined-value null-value boolean-value number-value string-value)) (oneof normal pv))
-                (object-value (typed-oneof value-or-exception abrupt (make-error (oneof coerce-to-primitive-error)))))))))
-       
-       (define (coerce-to-object (v value)) object-or-exception
-         (case v
-           (((undefined-value null-value)) (typed-oneof object-or-exception abrupt (make-error (oneof coerce-to-object-error))))
-           (boolean-value (bottom))
-           (number-value (bottom))
-           (string-value (bottom))
-           ((object-value o object) (oneof normal o))))
-       
-       (%section "Environments")
-       
-       (deftype env (tuple (this object-or-null)))
-       (define (lookup-identifier (e env :unused) (id string :unused)) reference-or-exception
-         (bottom))
-       
-       (%section "Terminal Actions")
-       
-       (declare-action eval-identifier $identifier string)
-       (declare-action eval-number $number float64)
-       (declare-action eval-string $string string)
-       
-       (terminal-action eval-identifier $identifier cdr)
-       (terminal-action eval-number $number cdr)
-       (terminal-action eval-string $string cdr)
-       (%print-actions)
-       
-       (%section "Primary Expressions")
-       
-       (declare-action eval :primary-rvalue (-> (env) value-or-exception))
-       (production :primary-rvalue (this) primary-rvalue-this
-         ((eval (e env))
-          (oneof normal (object-or-null-to-value (& this e)))))
-       (production :primary-rvalue (null) primary-rvalue-null
-         ((eval (e env :unused))
-          null-result))
-       (production :primary-rvalue (true) primary-rvalue-true
-         ((eval (e env :unused))
-          (boolean-result true)))
-       (production :primary-rvalue (false) primary-rvalue-false
-         ((eval (e env :unused))
-          (boolean-result false)))
-       (production :primary-rvalue ($number) primary-rvalue-number
-         ((eval (e env :unused))
-          (float64-result (eval-number $number))))
-       (production :primary-rvalue ($string) primary-rvalue-string
-         ((eval (e env :unused))
-          (string-result (eval-string $string))))
-       (production :primary-rvalue (\( (:comma-expression no-l-value) \)) primary-rvalue-parentheses
-         (eval (eval :comma-expression)))
-       
-       (declare-action eval :primary-lvalue (-> (env) reference-or-exception))
-       (production :primary-lvalue ($identifier) primary-lvalue-identifier
-         ((eval (e env))
-          (lookup-identifier e (eval-identifier $identifier))))
-       (production :primary-lvalue (\( :lvalue \)) primary-lvalue-parentheses
-         (eval (eval :lvalue)))
-       (%print-actions)
-       
-       (%section "Left-Side Expressions")
-       
-       (grammar-argument :expr-kind any-value no-l-value)
-       (grammar-argument :member-expr-kind call no-call)
-       
-       (declare-action eval (:member-lvalue :member-expr-kind) (-> (env) reference-or-exception))
-       (production (:member-lvalue no-call) (:primary-lvalue) member-lvalue-primary-lvalue
-         (eval (eval :primary-lvalue)))
-       (production (:member-lvalue call) (:lvalue :arguments) member-lvalue-call-member-lvalue
-         ((eval (e env))
-          (letexc (f-reference reference ((eval :lvalue) e))
-            (letexc (f value (reference-get-value f-reference))
-              (letexc (arguments (vector value) ((eval :arguments) e))
-                (let ((this object-or-null
-                            (case f-reference
-                              (((value-reference virtual-reference)) (oneof null-object-or-null))
-                              ((place-reference p place) (oneof object-object-or-null (& base p))))))
-                  (call-object f this arguments)))))))
-       (production (:member-lvalue call) ((:member-expression no-call no-l-value) :arguments) member-lvalue-call-member-expression-no-call
-         ((eval (e env))
-          (letexc (f value ((eval :member-expression) e))
-            (letexc (arguments (vector value) ((eval :arguments) e))
-              (call-object f (oneof null-object-or-null) arguments)))))
-       (production (:member-lvalue :member-expr-kind) ((:member-expression :member-expr-kind any-value) \[ :expression \]) member-lvalue-array
-         ((eval (e env))
-          (letexc (container value ((eval :member-expression) e))
-            (letexc (property value ((eval :expression) e))
-              (read-property container property)))))
-       (production (:member-lvalue :member-expr-kind) ((:member-expression :member-expr-kind any-value) \. $identifier) member-lvalue-property
-         ((eval (e env))
-          (letexc (container value ((eval :member-expression) e))
-            (read-property container (oneof string-value (eval-identifier $identifier))))))
-       
-       (declare-action eval (:member-expression :member-expr-kind :expr-kind) (-> (env) value-or-exception))
-       (%rule (:member-expression no-call no-l-value))
-       (%rule (:member-expression no-call any-value))
-       (%rule (:member-expression call any-value))
-       (production (:member-expression no-call :expr-kind) (:primary-rvalue) member-expression-primary-rvalue
-         (eval (eval :primary-rvalue)))
-       (production (:member-expression :member-expr-kind any-value) ((:member-lvalue :member-expr-kind)) member-expression-member-lvalue
-         ((eval (e env))
-          (letexc (ref reference ((eval :member-lvalue) e))
-            (reference-get-value ref))))
-       (production (:member-expression no-call :expr-kind) (new (:member-expression no-call any-value) :arguments) member-expression-new
-         ((eval (e env))
-          (letexc (constructor value ((eval :member-expression) e))
-            (letexc (arguments (vector value) ((eval :arguments) e))
-              (construct-object constructor arguments)))))
-       
-       (declare-action eval (:new-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:new-expression :expr-kind) ((:member-expression no-call :expr-kind)) new-expression-member-expression
-         (eval (eval :member-expression)))
-       (production (:new-expression :expr-kind) (new (:new-expression any-value)) new-expression-new
-         ((eval (e env))
-          (letexc (constructor value ((eval :new-expression) e))
-            (construct-object constructor (vector-of value)))))
-       
-       (declare-action eval :arguments (-> (env) value-list-or-exception))
-       (production :arguments (\( \)) arguments-empty
-         ((eval (e env :unused))
-          (oneof normal (vector-of value))))
-       (production :arguments (\( :argument-list \)) arguments-list
-         (eval (eval :argument-list)))
-       
-       (declare-action eval :argument-list (-> (env) value-list-or-exception))
-       (production :argument-list ((:assignment-expression any-value)) argument-list-one
-         ((eval (e env))
-          (letexc (arg value ((eval :assignment-expression) e))
-            (oneof normal (vector arg)))))
-       (production :argument-list (:argument-list \, (:assignment-expression any-value)) argument-list-more
-         ((eval (e env))
-          (letexc (args (vector value) ((eval :argument-list) e))
-            (letexc (arg value ((eval :assignment-expression) e))
-              (oneof normal (append args (vector arg)))))))
-       
-       (declare-action eval :lvalue (-> (env) reference-or-exception))
-       (production :lvalue ((:member-lvalue call)) lvalue-member-lvalue-call
-         (eval (eval :member-lvalue)))
-       (production :lvalue ((:member-lvalue no-call)) lvalue-member-lvalue-no-call
-         (eval (eval :member-lvalue)))
-       (%print-actions)
-       
-       (define (read-property (container value) (property value)) reference-or-exception
-         (letexc (obj object (coerce-to-object container))
-           (letexc (name prop-name (coerce-to-string property))
-             (oneof normal (oneof place-reference (tuple place obj name))))))
-       
-       (define (call-object (f value) (this object-or-null) (arguments (vector value))) reference-or-exception
-         (case f
-           (((undefined-value null-value boolean-value number-value string-value))
-            (typed-oneof reference-or-exception abrupt (make-error (oneof coerce-to-object-error))))
-           ((object-value o object)
-            ((& call o) this arguments))))
-       
-       (define (construct-object (constructor value) (arguments (vector value))) value-or-exception
-         (case constructor
-           (((undefined-value null-value boolean-value number-value string-value))
-            (typed-oneof value-or-exception abrupt (make-error (oneof coerce-to-object-error))))
-           ((object-value o object)
-            (letexc (res object ((& construct o) arguments))
-              (object-result res)))))
-       
-       (%section "Postfix Expressions")
-       
-       (declare-action eval (:postfix-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:postfix-expression :expr-kind) ((:new-expression :expr-kind)) postfix-expression-new
-         (eval (eval :new-expression)))
-       (production (:postfix-expression any-value) ((:member-expression call any-value)) postfix-expression-member-expression-call
-         (eval (eval :member-expression)))
-       (production (:postfix-expression :expr-kind) (:lvalue ++) postfix-expression-increment
-         ((eval (e env))
-          (letexc (operand-reference reference ((eval :lvalue) e))
-            (letexc (operand-value value (reference-get-value operand-reference))
-              (letexc (operand float64 (coerce-to-float64 operand-value))
-                (letexc (u void (reference-put-value operand-reference (oneof number-value (float64-add operand 1.0)))
-                           :unused)
-                  (float64-result operand)))))))
-       (production (:postfix-expression :expr-kind) (:lvalue --) postfix-expression-decrement
-         ((eval (e env))
-          (letexc (operand-reference reference ((eval :lvalue) e))
-            (letexc (operand-value value (reference-get-value operand-reference))
-              (letexc (operand float64 (coerce-to-float64 operand-value))
-                (letexc (u void (reference-put-value operand-reference (oneof number-value (float64-subtract operand 1.0)))
-                           :unused)
-                  (float64-result operand)))))))
-       (%print-actions)
-       
-       (%section "Unary Operators")
-       
-       (declare-action eval (:unary-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:unary-expression :expr-kind) ((:postfix-expression :expr-kind)) unary-expression-postfix
-         (eval (eval :postfix-expression)))
-       (production (:unary-expression :expr-kind) (delete :lvalue) unary-expression-delete
-         ((eval (e env))
-          (letexc (rv reference ((eval :lvalue) e))
-            (case rv
-              (value-reference (typed-oneof value-or-exception abrupt (make-error (oneof delete-error))))
-              ((place-reference r place)
-               (letexc (b boolean ((& delete (& base r)) (& property r)))
-                 (boolean-result b)))
-              (virtual-reference (boolean-result true))))))
-       (production (:unary-expression :expr-kind) (void (:unary-expression any-value)) unary-expression-void
-         ((eval (e env))
-          (letexc (operand value ((eval :unary-expression) e) :unused)
-            undefined-result)))
-       (production (:unary-expression :expr-kind) (typeof :lvalue) unary-expression-typeof-lvalue
-         ((eval (e env))
-          (letexc (rv reference ((eval :lvalue) e))
-            (case rv
-              ((value-reference v value) (string-result (value-typeof v)))
-              ((place-reference r place)
-               (letexc (v value ((& get (& base r)) (& property r)))
-                 (string-result (value-typeof v))))
-              (virtual-reference (string-result "undefined"))))))
-       (production (:unary-expression :expr-kind) (typeof (:unary-expression no-l-value)) unary-expression-typeof-expression
-         ((eval (e env))
-          (letexc (v value ((eval :unary-expression) e))
-            (string-result (value-typeof v)))))
-       (production (:unary-expression :expr-kind) (++ :lvalue) unary-expression-increment
-         ((eval (e env))
-          (letexc (operand-reference reference ((eval :lvalue) e))
-            (letexc (operand-value value (reference-get-value operand-reference))
-              (letexc (operand float64 (coerce-to-float64 operand-value))
-                (let ((res float64 (float64-add operand 1.0)))
-                  (letexc (u void (reference-put-value operand-reference (oneof number-value res)) :unused)
-                    (float64-result res))))))))
-       (production (:unary-expression :expr-kind) (-- :lvalue) unary-expression-decrement
-         ((eval (e env))
-          (letexc (operand-reference reference ((eval :lvalue) e))
-            (letexc (operand-value value (reference-get-value operand-reference))
-              (letexc (operand float64 (coerce-to-float64 operand-value))
-                (let ((res float64 (float64-subtract operand 1.0)))
-                  (letexc (u void (reference-put-value operand-reference (oneof number-value res)) :unused)
-                    (float64-result res))))))))
-       (production (:unary-expression :expr-kind) (+ (:unary-expression any-value)) unary-expression-plus
-         ((eval (e env))
-          (letexc (operand-value value ((eval :unary-expression) e))
-            (letexc (operand float64 (coerce-to-float64 operand-value))
-              (float64-result operand)))))
-       (production (:unary-expression :expr-kind) (- (:unary-expression any-value)) unary-expression-minus
-         ((eval (e env))
-          (letexc (operand-value value ((eval :unary-expression) e))
-            (letexc (operand float64 (coerce-to-float64 operand-value))
-              (float64-result (float64-negate operand))))))
-       (production (:unary-expression :expr-kind) (~ (:unary-expression any-value)) unary-expression-bitwise-not
-         ((eval (e env))
-          (letexc (operand-value value ((eval :unary-expression) e))
-            (letexc (operand integer (coerce-to-int32 operand-value))
-              (integer-result (bitwise-xor operand -1))))))
-       (production (:unary-expression :expr-kind) (! (:unary-expression any-value)) unary-expression-logical-not
-         ((eval (e env))
-          (letexc (operand-value value ((eval :unary-expression) e))
-            (boolean-result (not (coerce-to-boolean operand-value))))))
-       (%print-actions)
-       
-       (define (value-typeof (v value)) string
-         (case v
-           (undefined-value "undefined")
-           (null-value "object")
-           (boolean-value "boolean")
-           (number-value "number")
-           (string-value "string")
-           ((object-value o object) (& typeof-name o))))
-       
-       (%section "Multiplicative Operators")
-       
-       (declare-action eval (:multiplicative-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:multiplicative-expression :expr-kind) ((:unary-expression :expr-kind)) multiplicative-expression-unary
-         (eval (eval :unary-expression)))
-       (production (:multiplicative-expression :expr-kind) ((:multiplicative-expression any-value) * (:unary-expression any-value)) multiplicative-expression-multiply
-         ((eval (e env))
-          (letexc (left-value value ((eval :multiplicative-expression) e))
-            (letexc (right-value value ((eval :unary-expression) e))
-              (apply-binary-float64-operator float64-multiply left-value right-value)))))
-       (production (:multiplicative-expression :expr-kind) ((:multiplicative-expression any-value) / (:unary-expression any-value)) multiplicative-expression-divide
-         ((eval (e env))
-          (letexc (left-value value ((eval :multiplicative-expression) e))
-            (letexc (right-value value ((eval :unary-expression) e))
-              (apply-binary-float64-operator float64-divide left-value right-value)))))
-       (production (:multiplicative-expression :expr-kind) ((:multiplicative-expression any-value) % (:unary-expression any-value)) multiplicative-expression-remainder
-         ((eval (e env))
-          (letexc (left-value value ((eval :multiplicative-expression) e))
-            (letexc (right-value value ((eval :unary-expression) e))
-              (apply-binary-float64-operator float64-remainder left-value right-value)))))
-       (%print-actions)
-       
-       (define (apply-binary-float64-operator (operator (-> (float64 float64) float64)) (left-value value) (right-value value)) value-or-exception
-         (letexc (left-number float64 (coerce-to-float64 left-value))
-           (letexc (right-number float64 (coerce-to-float64 right-value))
-             (float64-result (operator left-number right-number)))))
-       
-       (%section "Additive Operators")
-       
-       (declare-action eval (:additive-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:additive-expression :expr-kind) ((:multiplicative-expression :expr-kind)) additive-expression-multiplicative
-         (eval (eval :multiplicative-expression)))
-       (production (:additive-expression :expr-kind) ((:additive-expression any-value) + (:multiplicative-expression any-value)) additive-expression-add
-         ((eval (e env))
-          (letexc (left-value value ((eval :additive-expression) e))
-            (letexc (right-value value ((eval :multiplicative-expression) e))
-              (letexc (left-primitive value (coerce-to-primitive left-value (oneof no-hint)))
-                (letexc (right-primitive value (coerce-to-primitive right-value (oneof no-hint)))
-                  (if (or (is string-value left-primitive) (is string-value right-primitive))
-                    (letexc (left-string string (coerce-to-string left-primitive))
-                      (letexc (right-string string (coerce-to-string right-primitive))
-                        (string-result (append left-string right-string))))
-                    (apply-binary-float64-operator float64-add left-primitive right-primitive))))))))
-       (production (:additive-expression :expr-kind) ((:additive-expression any-value) - (:multiplicative-expression any-value)) additive-expression-subtract
-         ((eval (e env))
-          (letexc (left-value value ((eval :additive-expression) e))
-            (letexc (right-value value ((eval :multiplicative-expression) e))
-              (apply-binary-float64-operator float64-subtract left-value right-value)))))
-       (%print-actions)
-       
-       (%section "Bitwise Shift Operators")
-       
-       (declare-action eval (:shift-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:shift-expression :expr-kind) ((:additive-expression :expr-kind)) shift-expression-additive
-         (eval (eval :additive-expression)))
-       (production (:shift-expression :expr-kind) ((:shift-expression any-value) << (:additive-expression any-value)) shift-expression-left
-         ((eval (e env))
-          (letexc (bitmap-value value ((eval :shift-expression) e))
-            (letexc (count-value value ((eval :additive-expression) e))
-              (letexc (bitmap integer (coerce-to-uint32 bitmap-value))
-                (letexc (count integer (coerce-to-uint32 count-value))
-                  (integer-result (uint32-to-int32 (bitwise-and (bitwise-shift bitmap (bitwise-and count #x1F))
-                                                                #xFFFFFFFF)))))))))
-       (production (:shift-expression :expr-kind) ((:shift-expression any-value) >> (:additive-expression any-value)) shift-expression-right-signed
-         ((eval (e env))
-          (letexc (bitmap-value value ((eval :shift-expression) e))
-            (letexc (count-value value ((eval :additive-expression) e))
-              (letexc (bitmap integer (coerce-to-int32 bitmap-value))
-                (letexc (count integer (coerce-to-uint32 count-value))
-                  (integer-result (bitwise-shift bitmap (neg (bitwise-and count #x1F))))))))))
-       (production (:shift-expression :expr-kind) ((:shift-expression any-value) >>> (:additive-expression any-value)) shift-expression-right-unsigned
-         ((eval (e env))
-          (letexc (bitmap-value value ((eval :shift-expression) e))
-            (letexc (count-value value ((eval :additive-expression) e))
-              (letexc (bitmap integer (coerce-to-uint32 bitmap-value))
-                (letexc (count integer (coerce-to-uint32 count-value))
-                  (integer-result (bitwise-shift bitmap (neg (bitwise-and count #x1F))))))))))
-       (%print-actions)
-       
-       (%section "Relational Operators")
-       
-       (declare-action eval (:relational-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:relational-expression :expr-kind) ((:shift-expression :expr-kind)) relational-expression-shift
-         (eval (eval :shift-expression)))
-       (production (:relational-expression :expr-kind) ((:relational-expression any-value) < (:shift-expression any-value)) relational-expression-less
-         ((eval (e env))
-          (letexc (left-value value ((eval :relational-expression) e))
-            (letexc (right-value value ((eval :shift-expression) e))
-              (order-values left-value right-value true false)))))
-       (production (:relational-expression :expr-kind) ((:relational-expression any-value) > (:shift-expression any-value)) relational-expression-greater
-         ((eval (e env))
-          (letexc (left-value value ((eval :relational-expression) e))
-            (letexc (right-value value ((eval :shift-expression) e))
-              (order-values right-value left-value true false)))))
-       (production (:relational-expression :expr-kind) ((:relational-expression any-value) <= (:shift-expression any-value)) relational-expression-less-or-equal
-         ((eval (e env))
-          (letexc (left-value value ((eval :relational-expression) e))
-            (letexc (right-value value ((eval :shift-expression) e))
-              (order-values right-value left-value false true)))))
-       (production (:relational-expression :expr-kind) ((:relational-expression any-value) >= (:shift-expression any-value)) relational-expression-greater-or-equal
-         ((eval (e env))
-          (letexc (left-value value ((eval :relational-expression) e))
-            (letexc (right-value value ((eval :shift-expression) e))
-              (order-values left-value right-value false true)))))
-       (%print-actions)
-       
-       (define (order-values (left-value value) (right-value value) (less boolean) (greater-or-equal boolean)) value-or-exception
-         (letexc (left-primitive value (coerce-to-primitive left-value (oneof number-hint)))
-           (letexc (right-primitive value (coerce-to-primitive right-value (oneof number-hint)))
-             (if (and (is string-value left-primitive) (is string-value right-primitive))
-               (boolean-result
-                (compare-strings (select string-value left-primitive) (select string-value right-primitive) less greater-or-equal greater-or-equal))
-               (letexc (left-number float64 (coerce-to-float64 left-primitive))
-                 (letexc (right-number float64 (coerce-to-float64 right-primitive))
-                   (boolean-result (float64-compare left-number right-number less greater-or-equal greater-or-equal false))))))))
-       
-       (define (compare-strings (left string) (right string) (less boolean) (equal boolean) (greater boolean)) boolean
-         (if (and (empty left) (empty right))
-           equal
-           (if (empty left)
-             less
-             (if (empty right)
-               greater
-               (let ((left-char-code integer (character-to-code (nth left 0)))
-                     (right-char-code integer (character-to-code (nth right 0))))
-                 (if (< left-char-code right-char-code)
-                   less
-                   (if (> left-char-code right-char-code)
-                     greater
-                     (compare-strings (subseq left 1) (subseq right 1) less equal greater))))))))
-       
-       (%section "Equality Operators")
-       
-       (declare-action eval (:equality-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:equality-expression :expr-kind) ((:relational-expression :expr-kind)) equality-expression-relational
-         (eval (eval :relational-expression)))
-       (production (:equality-expression :expr-kind) ((:equality-expression any-value) == (:relational-expression any-value)) equality-expression-equal
-         ((eval (e env))
-          (letexc (left-value value ((eval :equality-expression) e))
-            (letexc (right-value value ((eval :relational-expression) e))
-              (letexc (eq boolean (compare-values left-value right-value))
-                (boolean-result eq))))))
-       (production (:equality-expression :expr-kind) ((:equality-expression any-value) != (:relational-expression any-value)) equality-expression-not-equal
-         ((eval (e env))
-          (letexc (left-value value ((eval :equality-expression) e))
-            (letexc (right-value value ((eval :relational-expression) e))
-              (letexc (eq boolean (compare-values left-value right-value))
-                (boolean-result (not eq)))))))
-       (production (:equality-expression :expr-kind) ((:equality-expression any-value) === (:relational-expression any-value)) equality-expression-strict-equal
-         ((eval (e env))
-          (letexc (left-value value ((eval :equality-expression) e))
-            (letexc (right-value value ((eval :relational-expression) e))
-              (boolean-result (strict-compare-values left-value right-value))))))
-       (production (:equality-expression :expr-kind) ((:equality-expression any-value) !== (:relational-expression any-value)) equality-expression-strict-not-equal
-         ((eval (e env))
-          (letexc (left-value value ((eval :equality-expression) e))
-            (letexc (right-value value ((eval :relational-expression) e))
-              (boolean-result (not (strict-compare-values left-value right-value)))))))
-       (%print-actions)
-       
-       (define (compare-values (left-value value) (right-value value)) boolean-or-exception
-         (case left-value
-           (((undefined-value null-value))
-            (case right-value
-              (((undefined-value null-value)) (oneof normal true))
-              (((boolean-value number-value string-value object-value)) (oneof normal false))))
-           ((boolean-value left-bool boolean)
-            (case right-value
-              (((undefined-value null-value)) (oneof normal false))
-              ((boolean-value right-bool boolean) (oneof normal (not (xor left-bool right-bool))))
-              (((number-value string-value object-value))
-               (compare-float64-to-value (coerce-boolean-to-float64 left-bool) right-value))))
-           ((number-value left-number float64)
-            (compare-float64-to-value left-number right-value))
-           ((string-value left-str string)
-            (case right-value
-              (((undefined-value null-value)) (oneof normal false))
-              ((boolean-value right-bool boolean)
-               (letexc (left-number float64 (coerce-to-float64 left-value))
-                 (oneof normal (float64-equal left-number (coerce-boolean-to-float64 right-bool)))))
-              ((number-value right-number float64)
-               (letexc (left-number float64 (coerce-to-float64 left-value))
-                 (oneof normal (float64-equal left-number right-number))))
-              ((string-value right-str string)
-               (oneof normal (compare-strings left-str right-str false true false)))
-              (object-value
-               (letexc (right-primitive value (coerce-to-primitive right-value (oneof no-hint)))
-                 (compare-values left-value right-primitive)))))
-           ((object-value left-obj object)
-            (case right-value
-              (((undefined-value null-value)) (oneof normal false))
-              ((boolean-value right-bool boolean)
-               (letexc (left-primitive value (coerce-to-primitive left-value (oneof no-hint)))
-                 (compare-values left-primitive (oneof number-value (coerce-boolean-to-float64 right-bool)))))
-              (((number-value string-value))
-               (letexc (left-primitive value (coerce-to-primitive left-value (oneof no-hint)))
-                 (compare-values left-primitive right-value)))
-              ((object-value right-obj object)
-               (oneof normal (address-equal (& properties left-obj) (& properties right-obj))))))))
-       
-       (define (compare-float64-to-value (left-number float64) (right-value value)) boolean-or-exception
-         (case right-value
-           (((undefined-value null-value)) (oneof normal false))
-           (((boolean-value number-value string-value))
-            (letexc (right-number float64 (coerce-to-float64 right-value))
-              (oneof normal (float64-equal left-number right-number))))
-           (object-value
-            (letexc (right-primitive value (coerce-to-primitive right-value (oneof no-hint)))
-              (compare-float64-to-value left-number right-primitive)))))
-       
-       (define (float64-equal (x float64) (y float64)) boolean
-         (float64-compare x y false true false false))
-       
-       (define (strict-compare-values (left-value value) (right-value value)) boolean
-         (case left-value
-           (undefined-value
-            (is undefined-value right-value))
-           (null-value
-            (is null-value right-value))
-           ((boolean-value left-bool boolean)
-            (case right-value
-              ((boolean-value right-bool boolean) (not (xor left-bool right-bool)))
-              (((undefined-value null-value number-value string-value object-value)) false)))
-           ((number-value left-number float64)
-            (case right-value
-              ((number-value right-number float64) (float64-equal left-number right-number))
-              (((undefined-value null-value boolean-value string-value object-value)) false)))
-           ((string-value left-str string)
-            (case right-value
-              ((string-value right-str string)
-               (compare-strings left-str right-str false true false))
-              (((undefined-value null-value boolean-value number-value object-value)) false)))
-           ((object-value left-obj object)
-            (case right-value
-              ((object-value right-obj object)
-               (address-equal (& properties left-obj) (& properties right-obj)))
-              (((undefined-value null-value boolean-value number-value string-value)) false)))))
-       
-       (%section "Binary Bitwise Operators")
-       
-       (declare-action eval (:bitwise-and-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:bitwise-and-expression :expr-kind) ((:equality-expression :expr-kind)) bitwise-and-expression-equality
-         (eval (eval :equality-expression)))
-       (production (:bitwise-and-expression :expr-kind) ((:bitwise-and-expression any-value) & (:equality-expression any-value)) bitwise-and-expression-and
-         ((eval (e env))
-          (letexc (left-value value ((eval :bitwise-and-expression) e))
-            (letexc (right-value value ((eval :equality-expression) e))
-              (apply-binary-bitwise-operator bitwise-and left-value right-value)))))
-       
-       (declare-action eval (:bitwise-xor-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:bitwise-xor-expression :expr-kind) ((:bitwise-and-expression :expr-kind)) bitwise-xor-expression-bitwise-and
-         (eval (eval :bitwise-and-expression)))
-       (production (:bitwise-xor-expression :expr-kind) ((:bitwise-xor-expression any-value) ^ (:bitwise-and-expression any-value)) bitwise-xor-expression-xor
-         ((eval (e env))
-          (letexc (left-value value ((eval :bitwise-xor-expression) e))
-            (letexc (right-value value ((eval :bitwise-and-expression) e))
-              (apply-binary-bitwise-operator bitwise-xor left-value right-value)))))
-       
-       (declare-action eval (:bitwise-or-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:bitwise-or-expression :expr-kind) ((:bitwise-xor-expression :expr-kind)) bitwise-or-expression-bitwise-xor
-         (eval (eval :bitwise-xor-expression)))
-       (production (:bitwise-or-expression :expr-kind) ((:bitwise-or-expression any-value) \| (:bitwise-xor-expression any-value)) bitwise-or-expression-or
-         ((eval (e env))
-          (letexc (left-value value ((eval :bitwise-or-expression) e))
-            (letexc (right-value value ((eval :bitwise-xor-expression) e))
-              (apply-binary-bitwise-operator bitwise-or left-value right-value)))))
-       (%print-actions)
-       
-       (define (apply-binary-bitwise-operator (operator (-> (integer integer) integer)) (left-value value) (right-value value)) value-or-exception
-         (letexc (left-int integer (coerce-to-int32 left-value))
-           (letexc (right-int integer (coerce-to-int32 right-value))
-             (integer-result (operator left-int right-int)))))
-       
-       (%section "Binary Logical Operators")
-       
-       (declare-action eval (:logical-and-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:logical-and-expression :expr-kind) ((:bitwise-or-expression :expr-kind)) logical-and-expression-bitwise-or
-         (eval (eval :bitwise-or-expression)))
-       (production (:logical-and-expression :expr-kind) ((:logical-and-expression any-value) && (:bitwise-or-expression any-value)) logical-and-expression-and
-         ((eval (e env))
-          (letexc (left-value value ((eval :logical-and-expression) e))
-            (if (coerce-to-boolean left-value)
-              ((eval :bitwise-or-expression) e)
-              (oneof normal left-value)))))
-       
-       (declare-action eval (:logical-or-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:logical-or-expression :expr-kind) ((:logical-and-expression :expr-kind)) logical-or-expression-logical-and
-         (eval (eval :logical-and-expression)))
-       (production (:logical-or-expression :expr-kind) ((:logical-or-expression any-value) \|\| (:logical-and-expression any-value)) logical-or-expression-or
-         ((eval (e env))
-          (letexc (left-value value ((eval :logical-or-expression) e))
-            (if (coerce-to-boolean left-value)
-              (oneof normal left-value)
-              ((eval :logical-and-expression) e)))))
-       (%print-actions)
-       
-       (%section "Conditional Operator")
-       
-       (declare-action eval (:conditional-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:conditional-expression :expr-kind) ((:logical-or-expression :expr-kind)) conditional-expression-logical-or
-         (eval (eval :logical-or-expression)))
-       (production (:conditional-expression :expr-kind) ((:logical-or-expression any-value) ? (:assignment-expression any-value) \: (:assignment-expression any-value)) conditional-expression-conditional
-         ((eval (e env))
-          (letexc (condition value ((eval :logical-or-expression) e))
-            (if (coerce-to-boolean condition)
-              ((eval :assignment-expression 1) e)
-              ((eval :assignment-expression 2) e)))))
-       (%print-actions)
-       
-       (%section "Assignment Operators")
-       
-       (declare-action eval (:assignment-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:assignment-expression :expr-kind) ((:conditional-expression :expr-kind)) assignment-expression-conditional
-         (eval (eval :conditional-expression)))
-       (production (:assignment-expression :expr-kind) (:lvalue = (:assignment-expression any-value)) assignment-expression-assignment
-         ((eval (e env))
-          (letexc (left-reference reference ((eval :lvalue) e))
-            (letexc (right-value value ((eval :assignment-expression) e))
-              (letexc (u void (reference-put-value left-reference right-value) :unused)
-                (oneof normal right-value))))))
-       #|
-       (production (:assignment-expression :expr-kind) (:lvalue :compound-assignment (:assignment-expression any-value)) assignment-expression-compound-assignment
-         ((eval (e env))
-          (letexc (left-reference reference ((eval :lvalue) e))
-            (letexc (left-value value (reference-get-value left-reference))
-              (letexc (right-value value ((eval :assignment-expression) e))
-                (letexc (res-value ((compound-operator :compound-assignment) left-value right-value))
-                  (letexc (u void (reference-put-value left-reference res-value) :unused)
-                    (oneof normal res-value))))))))
-       
-       (declare-action compound-operator :compound-assignment (-> (value value) value-or-exception))
-       (production :compound-assignment (*=) compound-assignment-multiply
-         (compound-operator (binary-float64-compound-operator float64-multiply)))
-       (production :compound-assignment (/=) compound-assignment-divide
-         (compound-operator (binary-float64-compound-operator float64-divide)))
-       (production :compound-assignment (%=) compound-assignment-remainder
-         (compound-operator (binary-float64-compound-operator float64-remainder)))
-       (production :compound-assignment (+=) compound-assignment-add
-         (compound-operator (binary-float64-compound-operator float64-remainder)))
-       (production :compound-assignment (-=) compound-assignment-subtract
-         (compound-operator (binary-float64-compound-operator float64-subtract)))
-       (%print-actions)
-       
-       (define (binary-float64-compound-operator (operator (-> (float64 float64) float64))) (-> (value value) value-or-exception)
-         (function ((left-value value) (right-value value))
-           (letexc (left-number float64 (coerce-to-float64 left-value))
-             (letexc (right-number float64 (coerce-to-float64 right-value))
-               (oneof normal (oneof number-value (operator left-number right-number)))))))
-       |#
-       (%section "Expressions")
-       
-       (declare-action eval (:comma-expression :expr-kind) (-> (env) value-or-exception))
-       (production (:comma-expression :expr-kind) ((:assignment-expression :expr-kind)) comma-expression-assignment
-         (eval (eval :assignment-expression)))
-       (%print-actions)
-       
-       (declare-action eval :expression (-> (env) value-or-exception))
-       (production :expression ((:comma-expression any-value)) expression-comma-expression
-         (eval (eval :comma-expression)))
-       (%print-actions)
-       
-       (%section "Programs")
-       
-       (declare-action eval :program value-or-exception)
-       (production :program (:expression $end) program
-         (eval ((eval :expression) (tuple env (oneof null-object-or-null)))))
-       )))
-  
-  (defparameter *gg* (world-grammar *gw* 'code-grammar)))
-
-
-(defun token-terminal (token)
-  (if (symbolp token)
-    token
-    (car token)))
-
-(defun ecma-parse-tokens (tokens &key trace)
-  (action-parse *gg* #'token-terminal tokens :trace trace))
-
-
-(defun ecma-parse (string &key trace)
-  (let ((tokens (tokenize string)))
-    (when trace
-      (format *trace-output* "~S~%" tokens))
-    (action-parse *gg* #'token-terminal tokens :trace trace)))
-
-
-; Same as ecma-parse except that also print the action results nicely.
-(defun ecma-pparse (string &key (stream t) trace)
-  (multiple-value-bind (results types) (ecma-parse string :trace trace)
-    (print-values results types stream)
-    (terpri stream)
-    (values results types)))
-
-
-#|
-(depict-rtf-to-local-file
- "JSECMA/ParserSemantics.rtf"
- "ECMAScript 1 Parser Semantics"
- #'(lambda (rtf-stream)
-     (depict-world-commands rtf-stream *gw*)))
-
-(depict-html-to-local-file
- "JSECMA/ParserSemantics.html"
- "ECMAScript 1 Parser Semantics"
- t
- #'(lambda (rtf-stream)
-     (depict-world-commands rtf-stream *gw*)))
-
-(with-local-output (s "JSECMA/ParserGrammar.txt") (print-grammar *gg* s))
-
-
-(ecma-pparse "('abc')")
-(ecma-pparse "!~ 352")
-(ecma-pparse "1e308%.125")
-(ecma-pparse "-3>>>10-6")
-(ecma-pparse "-3>>0")
-(ecma-pparse "1+2*3|16")
-(ecma-pparse "1==true")
-(ecma-pparse "1=true")
-(ecma-pparse "x=true")
-(ecma-pparse "2*4+17+0x32")
-(ecma-pparse "+'ab'+'de'")
-|#

mozilla/js2/semantics/Lexer.lisp

@@ -1,779 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; Lexer grammar generator
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-;;; A lexer grammar is an extension of a standard grammar that combines both parsing and combining
-;;; characters into character classes.
-;;;
-;;; A lexer grammar is comprised of the following:
-;;;   a start nonterminal;
-;;;   a list of grammar productions, in which each terminal must be a character;
-;;;   a list of character classes, where each class is a list of:
-;;;     a nonterminal C;
-;;;     an expression <set-expr> that denotes the set of characters in character class C;
-;;;     a list of bindings, each containing:
-;;;       an action name;
-;;;       a lexer-action name;
-;;;   a list of lexer-action bindings, each containing:
-;;;     a lexer-action name;
-;;;     the type of this lexer-action's value;
-;;;     the name of a lisp function (char -> value) that performs the lexer-action on a character.
-;;;
-;;; Grammar productions may refer to character classes C as nonterminals.
-;;;
-;;; An expression <set-expr> can be any of the following:
-;;;   C                                   The name of a previously defined character class.
-;;;   (char1 char2 ... charn)             The set of characters {char1, char2, ..., charn}
-;;;   (+ <set-expr1> ... <set-exprn>)     The set union of <set-expr1>, ..., <set-exprn>,
-;;;                                       which should be disjoint.
-;;;   (++ <set-expr1> ... <set-exprn>)    Same as +, but printed on separate lines.
-;;;   (- <set-expr1> <set-expr2>)         The set of characters in <set-expr1> but not <set-expr2>;
-;;;                                       <set-expr2> should be a subset of <set-expr1>.
-;;;   (% <builtin-class> . <description>) A predefined set of characters.  <description> is suitable for
-;;;                                       depicting.
-;;;
-;;; <builtin-class> can be one of the following:
-;;;   every                    The set of all characters
-;;;   initial-alpha            The set of characters suitable for the beginning of a Unicode identifier
-;;;   alphanumeric             The set of Unicode identifier continuation characters
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; SETS OF CHARACTERS
-
-;;; A character set is represented by an integer.
-;;; The set may be infinite as long as its complement is finite.
-;;; Bit n is set if the character with code n is a member of the set.
-;;; The integer is negative if the set is infinite.
-
-
-; Print the charset
-(defun print-charset (charset &optional (stream t))
-  (pprint-logical-block (stream (bitmap-to-ranges charset) :prefix "{" :suffix "}")
-    (pprint-exit-if-list-exhausted)
-    (loop
-      (flet
-        ((int-to-char (i)
-           (if (or (eq i :infinity) (= i char-code-limit))
-             :infinity
-             (code-char i))))
-        (let* ((range (pprint-pop))
-               (lo (int-to-char (car range)))
-               (hi (int-to-char (cdr range))))
-          (write (if (eql lo hi) lo (list lo hi)) :stream stream :pretty t)
-          (pprint-exit-if-list-exhausted)
-          (format stream " ~:_"))))))
-
-
-(defconstant *empty-charset* 0)
-
-
-; Return the character set consisting of the single character char.
-(declaim (inline char-charset))
-(defun char-charset (char)
-  (ash 1 (char-code char)))
-
-
-; Return the character set consisting of adding char to the given charset.
-(defun charset-add-char (charset char)
-  (let ((i (char-code char)))
-    (if (logbitp i charset)
-      charset
-      (logior charset (ash 1 i)))))
-
-
-; Return the character set consisting of adding the character range to the given charset.
-(defun charset-add-range (charset low-char high-char)
-  (let ((low (char-code low-char))
-        (high (char-code high-char)))
-    (assert-true (>= high low))
-    (dpb -1 (byte (1+ (- high low)) low) charset)))
-
-
-; Return the union of the two character sets, which should be disjoint.
-(defun charset-union (charset1 charset2)
-  (unless (zerop (logand charset1 charset2))
-    (error "Union of overlapping character sets"))
-  (logior charset1 charset2))
-
-
-; Return the difference of the two character sets, the second of which should be
-; a subset of the first.
-(defun charset-difference (charset1 charset2)
-  (unless (zerop (logandc1 charset1 charset2))
-    (error "Difference of non-subset character sets"))
-  (logandc2 charset1 charset2))
-
-
-; Return true if the character set is empty.
-(declaim (inline charset-empty?))
-(defun charset-empty? (charset)
-  (zerop charset))
-
-
-; Return true if the character set is infinite.
-(declaim (inline charset-infinite?))
-(defun charset-infinite? (charset)
-  (minusp charset))
-
-
-; Return true if the character set contains the given character.
-(declaim (inline char-in-charset?))
-(defun char-in-charset? (charset char)
-  (logbitp (char-code char) charset))
-
-
-; If the character set contains exactly one character, return that character;
-; otherwise, return nil.
-(defun charset-char (charset)
-  (let ((hi (1- (integer-length charset))))
-    (and (plusp charset) (= charset (ash 1 hi)) (code-char hi))))
-
-
-; Return the highest character in the character set, which must be finite and nonempty.
-(declaim (inline charset-highest-char))
-(defun charset-highest-char (charset)
-  (assert-true (plusp charset))
-  (code-char (1- (integer-length charset))))
-
-
-; Given a list of charsets, return a list of the largest possible
-; charsets (called partitions) such that:
-;   for any input charset C and partition P, either P is entirely contained in C or it is disjoint from C;
-;   all partitions are mutually disjoint;
-;   the union of all partitions is the infinite set of all characters.
-(defun compute-partitions (charsets)
-  (labels
-    ((split-partitions (partitions charset)
-       (mapcan #'(lambda (partition)
-                   (remove-if #'zerop (list (logand partition charset) (logandc2 partition charset))))
-               partitions))
-     (partition< (partition1 partition2)
-       (cond
-        ((minusp partition1) nil)
-        ((minusp partition2) t)
-        (t (< partition1 partition2)))))
-    (sort (reduce #'split-partitions charsets :initial-value '(-1))
-          #'partition<)))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; PREDEFINED SETS OF CHARACTERS
-
-(defmacro predefined-character-set (symbol)
-  `(get ,symbol 'predefined-character-set))
-
-
-; Predefine a character set with the given name.  The set is specified by char-ranges, which is a
-; list of single characters or two-elements (low-char high-char) lists; both low-char and high-char
-; are inclusive.
-
-(defun define-character-set (symbol char-ranges)
-  (let ((charset *empty-charset*))
-    (dolist (char-range char-ranges)
-      (setq charset 
-            (if (characterp char-range)
-              (charset-add-char charset char-range)
-              (charset-add-range charset (first char-range) (second char-range)))))
-    (setf (predefined-character-set symbol) charset)))
-
-
-(setf (predefined-character-set 'every) -1)
-(define-character-set 'initial-alpha '((#\A #\Z) (#\a #\z)))
-(define-character-set 'alphanumeric '((#\0 #\9) (#\A #\Z) (#\a #\z)))
-
-(define-character-set '*initial-identifier-character* '(#\$ #\_ (#\A #\Z) (#\a #\z)))
-(define-character-set '*continuing-identifier-character* '(#\$ #\_ (#\0 #\9) (#\A #\Z) (#\a #\z)))
-
-(defun initial-identifier-character? (char)
-  (char-in-charset? (predefined-character-set '*initial-identifier-character*) char))
-
-(defun continuing-identifier-character? (char)
-  (char-in-charset? (predefined-character-set '*continuing-identifier-character*) char))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; LEXER-ACTIONS
-
-(defstruct (lexer-action (:constructor make-lexer-action (name number type-expr function-name function))
-                         (:copier nil)
-                         (:predicate lexer-action?))
-  (name nil :type identifier :read-only t)             ;The action name to use for this lexer-action
-  (number nil :type integer :read-only t)              ;Serial number of this lexer-action
-  (type-expr nil :read-only t)                         ;A type expression that specifies the result type of function
-  (function-name nil :type (or null identifier) :read-only t) ;Name of external function to use when depicting this lexer-action
-  (function nil :type identifier :read-only t))        ;A lisp function (char -> value) that performs the lexer-action on a character
-
-
-(defun print-lexer-action (lexer-action &optional (stream t))
-  (format stream "~@<~A ~@_~:I: ~<<<~;~W~;>>~:> ~_= ~<<~;#'~W~;>~:>~:>"
-          (lexer-action-name lexer-action)
-          (list (lexer-action-type-expr lexer-action))
-          (list (lexer-action-function lexer-action))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; CHARCLASSES
-
-(defstruct (charclass (:constructor make-charclass (nonterminal charset-source charset actions hidden))
-                      (:predicate charclass?))
-  (nonterminal nil :type nonterminal :read-only t)    ;The nonterminal on the left-hand side of this production
-  (charset-source nil :read-only t)                   ;The source expression for the charset
-  (charset nil :type integer :read-only t)            ;The set of characters in this class
-  (actions nil :type list :read-only t)               ;List of (action-name . lexer-action)
-  (hidden nil :type bool :read-only t))               ;True if this charclass should not be in the grammar
-
-
-; Return a copy of the charset expr with all parametrized nonterminals interned.
-(defun intern-charset-expr (parametrization expr)
-  (cond
-   ((or (not (consp expr)) (eq (first expr) '%)) expr)
-   ((keywordp (first expr)) (assert-type (grammar-parametrization-intern parametrization expr) nonterminal))
-   (t (mapcar #'(lambda (subexpr)
-                  (intern-charset-expr parametrization subexpr))
-              expr))))
-
-
-; Evaluate a <set-expr> whose syntax is given at the top of this file.
-; Return the charset.
-; charclasses-hash is a hash table of nonterminal -> charclass.
-(defun eval-charset-expr (charclasses-hash expr)
-  (cond
-   ((null expr) 0)
-   ((nonterminal? expr)
-    (charclass-charset
-     (or (gethash expr charclasses-hash)
-         (error "Character class ~S not defined" expr))))
-   ((consp expr)
-    (labels
-      ((recursive-eval (expr)
-         (eval-charset-expr charclasses-hash expr)))
-      (case (first expr)
-        ((+ ++) (reduce #'charset-union (rest expr) :initial-value 0 :key #'recursive-eval))
-        (- (unless (rest expr)
-             (error "Bad character set expression ~S" expr))
-           (reduce #'charset-difference (rest expr) :key #'recursive-eval))
-        (% (assert-non-null (predefined-character-set (second expr))))
-        (t (reduce #'charset-union expr :key #'char-charset)))))
-   (t (error "Bad character set expression ~S" expr))))
-
-
-(defun print-charclass (charclass &optional (stream t))
-  (pprint-logical-block (stream nil)
-    (format stream "~W -> ~@_~:I" (charclass-nonterminal charclass))
-    (print-charset (charclass-charset charclass) stream)
-    (format stream " ~_")
-    (pprint-fill stream (mapcar #'car (charclass-actions charclass)))
-    (when (charclass-hidden charclass)
-      (format stream " ~_hidden"))))
-
-
-; Emit markup for the lexer charset expression.
-(defun depict-charset-source (markup-stream expr)
-  (cond
-   ((null expr) (error "Can't emit null charset expression"))
-   ((nonterminal? expr) (depict-general-nonterminal markup-stream expr :reference))
-   ((consp expr)
-    (case (first expr)
-      ((+ ++) (depict-list markup-stream #'depict-charset-source (rest expr) :separator " | "))
-      (- (depict-charset-source markup-stream (second expr))
-         (depict markup-stream " " :but-not " ")
-         (depict-list markup-stream #'depict-charset-source (cddr expr) :separator " | "))
-      (% (depict-styled-text markup-stream (cddr expr)))
-      (t (depict-list markup-stream #'depict-terminal expr :separator " | "))))
-   (t (error "Bad character set expression ~S" expr))))
-
-
-; Emit markup paragraphs for the lexer charclass.
-(defun depict-charclass (markup-stream charclass)
-  (depict-block-style (markup-stream ':grammar-rule)
-    (let ((nonterminal (charclass-nonterminal charclass))
-          (expr (charclass-charset-source charclass)))
-      (if (and (consp expr) (eq (first expr) '++))
-        (let* ((subexprs (rest expr))
-               (length (length subexprs)))
-          (depict-paragraph (markup-stream ':grammar-lhs)
-            (depict-general-nonterminal markup-stream nonterminal :definition)
-            (depict markup-stream " " ':derives-10))
-          (dotimes (i length)
-            (depict-paragraph (markup-stream (if (= i (1- length)) ':grammar-rhs-last ':grammar-rhs))
-              (if (zerop i)
-                (depict markup-stream ':tab3)
-                (depict markup-stream "|" ':tab2))
-              (depict-charset-source markup-stream (nth i subexprs)))))
-        (depict-paragraph (markup-stream ':grammar-lhs-last)
-          (depict-general-nonterminal markup-stream (charclass-nonterminal charclass) :definition)
-          (depict markup-stream " " ':derives-10 " ")
-          (depict-charset-source markup-stream expr))))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; PARTITIONS
-
-(defstruct (partition (:constructor make-partition (charset lexer-actions))
-                      (:predicate partition?))
-  (charset nil :type integer :read-only t)            ;The set of characters in this partition
-  (lexer-actions nil :type list :read-only t))        ;List of lexer-actions needed on characters in this partition
-
-(defconstant *default-partition-name* '$_other_) ;partition-name to use for characters not found in lexer-char-tokens
-
-
-(defun print-partition (partition-name partition &optional (stream t))
-  (pprint-logical-block (stream nil)
-    (format stream "~W -> ~@_~:I" partition-name)
-    (print-charset (partition-charset partition) stream)
-    (format stream " ~_")
-    (pprint-fill stream (mapcar #'lexer-action-name (partition-lexer-actions partition)))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; LEXER
-
-
-(defstruct (lexer (:constructor allocate-lexer)
-                  (:copier nil)
-                  (:predicate lexer?))
-  (lexer-actions nil :type hash-table :read-only t)    ;Hash table of lexer-action-name -> lexer-action
-  (charclasses nil :type list :read-only t)            ;List of charclasses in the order in which they were given
-  (charclasses-hash nil :type hash-table :read-only t) ;Hash table of nonterminal -> charclass
-  (char-tokens nil :type hash-table :read-only t)      ;Hash table of character -> (character or partition-name)
-  (partition-names nil :type list :read-only t)        ;List of partition names in the order in which they were created
-  (partitions nil :type hash-table :read-only t)       ;Hash table of partition-name -> partition
-  (grammar nil :type (or null grammar))                ;Grammar that accepts exactly one lexer token
-  (metagrammar nil :type (or null metagrammar)))       ;Grammar that accepts the longest input sequence that forms a token
-
-
-; Return a function (character -> terminal) that classifies an input character
-; as either itself or a partition-name.
-; If the returned function is called on a non-character, it returns its input unchanged.
-(defun lexer-classifier (lexer)
-  (let ((char-tokens (lexer-char-tokens lexer)))
-    #'(lambda (char)
-        (if (characterp char)
-          (gethash char char-tokens *default-partition-name*)
-          char))))
-
-
-; Return the charclass that defines the given lexer nonterminal or nil if none.
-(defun lexer-charclass (lexer nonterminal)
-  (gethash nonterminal (lexer-charclasses-hash lexer)))
-
-
-; Return the charset of all characters that appear as terminals in grammar-source.
-(defun grammar-singletons (grammar-source)
-  (assert-type grammar-source (list (tuple t (list t) identifier t)))
-  (let ((singletons 0))
-    (labels
-      ((scan-for-singletons (list)
-         (dolist (element list)
-           (cond
-            ((characterp element)
-             (setq singletons (charset-add-char singletons element)))
-            ((consp element)
-             (case (first element)
-               (:- (scan-for-singletons (rest element)))
-               (:-- (scan-for-singletons (cddr element)))))))))
-      
-      (dolist (production-source grammar-source)
-        (scan-for-singletons (second production-source))))
-    singletons))
-
-
-; Return the list of all lexer-action-names that appear in at least one charclass of which this
-; partition is a subset.
-(defun collect-lexer-action-names (charclasses partition)
-  (let ((lexer-action-names nil))
-    (dolist (charclass charclasses)
-      (unless (zerop (logand (charclass-charset charclass) partition))
-        (dolist (action (charclass-actions charclass))
-          (pushnew (cdr action) lexer-action-names))))
-    (sort lexer-action-names #'< :key #'lexer-action-number)))
-
-
-; Make a lexer structure corresponding to a grammar with the given source.
-; charclasses-source is a list of character classes, where each class is a list of:
-;     a nonterminal C (may be a list to specify an attributed-nonterminal);
-;     an expression <set-expr> that denotes the set of characters in character class C;
-;     a list of bindings, each containing:
-;       an action name;
-;       a lexer-action name;
-;     an optional flag that indicatest that the character class should not be in the grammar.
-; lexer-actions-source is a list of lexer-action bindings, each containing:
-;     a lexer-action name;
-;     the type of this lexer-action's value;
-;     the name of a primitive to use when depicting this lexer-action's definition;
-;     the name of a lisp function (char -> value) that performs the lexer-action on a character.
-; This does not make the lexer's grammar; use make-lexer-and-grammar for that.
-(defun make-lexer (parametrization charclasses-source lexer-actions-source grammar-source)
-  (assert-type charclasses-source (list (cons t (cons t (cons (list (tuple identifier identifier)) t)))))
-  (assert-type lexer-actions-source (list (tuple identifier t (or null identifier) identifier)))
-  (let ((lexer-actions (make-hash-table :test #'eq))
-        (charclasses nil)
-        (charclasses-hash (make-hash-table :test *grammar-symbol-=*))
-        (charsets nil)
-        (singletons (grammar-singletons grammar-source)))
-    (let ((lexer-action-number 0))
-      (dolist (lexer-action-source lexer-actions-source)
-        (let ((name (first lexer-action-source))
-              (type-expr (second lexer-action-source))
-              (function-name (third lexer-action-source))
-              (function (fourth lexer-action-source)))
-          (when (gethash name lexer-actions)
-            (error "Attempt to redefine lexer action ~S" name))
-          (setf (gethash name lexer-actions)
-                (make-lexer-action name (incf lexer-action-number) type-expr function-name function)))))
-    
-    (dolist (charclass-source charclasses-source)
-      (let* ((nonterminal (assert-type (grammar-parametrization-intern parametrization (first charclass-source)) nonterminal))
-             (charset-source (intern-charset-expr parametrization (ensure-proper-form (second charclass-source))))
-             (charset (eval-charset-expr charclasses-hash charset-source))
-             (actions 
-              (mapcar #'(lambda (action-source)
-                          (let* ((lexer-action-name (second action-source))
-                                 (lexer-action (gethash lexer-action-name lexer-actions)))
-                            (unless lexer-action
-                              (error "Unknown lexer-action ~S" lexer-action-name))
-                            (cons (first action-source) lexer-action)))
-                      (third charclass-source))))
-        (when (gethash nonterminal charclasses-hash)
-          (error "Attempt to redefine character class ~S" nonterminal))
-        (when (charset-empty? charset)
-          (error "Empty character class ~S" nonterminal))
-        (let ((charclass (make-charclass nonterminal charset-source charset actions (fourth charclass-source))))
-          (push charclass charclasses)
-          (setf (gethash nonterminal charclasses-hash) charclass)
-          (push charset charsets))))
-    (setq charclasses (nreverse charclasses))
-    (bitmap-each-bit #'(lambda (i) (push (ash 1 i) charsets))
-                     singletons)
-    (let ((char-tokens (make-hash-table :test #'eql))
-          (partition-names nil)
-          (partitions (make-hash-table :test #'eq))
-          (current-partition-number 0))
-      (dolist (partition (compute-partitions charsets))
-        (let ((singleton (charset-char partition)))
-          (cond
-           (singleton (setf (gethash singleton char-tokens) singleton))
-           ((charset-infinite? partition)
-            (push *default-partition-name* partition-names)
-            (setf (gethash *default-partition-name* partitions)
-                  (make-partition partition (collect-lexer-action-names charclasses partition))))
-           (t (let ((token (intern (format nil "$_CHARS~D_" (incf current-partition-number)))))
-                (bitmap-each-bit #'(lambda (i)
-                                     (setf (gethash (code-char i) char-tokens) token))
-                                 partition)
-                (push token partition-names)
-                (setf (gethash token partitions)
-                      (make-partition partition (collect-lexer-action-names charclasses partition))))))))
-      (allocate-lexer
-       :lexer-actions lexer-actions
-       :charclasses charclasses
-       :charclasses-hash charclasses-hash
-       :char-tokens char-tokens
-       :partition-names (nreverse partition-names)
-       :partitions partitions))))
-
-
-(defun print-lexer (lexer &optional (stream t))
-  (let* ((lexer-actions (lexer-lexer-actions lexer))
-         (lexer-action-names (sort (hash-table-keys lexer-actions) #'<
-                                   :key #'(lambda (lexer-action-name)
-                                            (lexer-action-number (gethash lexer-action-name lexer-actions)))))
-         (charclasses (lexer-charclasses lexer))
-         (partition-names (lexer-partition-names lexer))
-         (partitions (lexer-partitions lexer))
-         (singletons nil))
-    
-    (when lexer-action-names
-      (pprint-logical-block (stream lexer-action-names)
-        (format stream "Lexer Actions:~2I")
-        (loop
-          (pprint-newline :mandatory stream)
-          (let ((lexer-action (gethash (pprint-pop) lexer-actions)))
-            (print-lexer-action lexer-action stream))
-          (pprint-exit-if-list-exhausted)))
-      (pprint-newline :mandatory stream)
-      (pprint-newline :mandatory stream))
-    
-    (when charclasses
-      (pprint-logical-block (stream charclasses)
-        (format stream "Charclasses:~2I")
-        (loop
-          (pprint-newline :mandatory stream)
-          (let ((charclass (pprint-pop)))
-            (print-charclass charclass stream))
-          (pprint-exit-if-list-exhausted)))
-      (pprint-newline :mandatory stream)
-      (pprint-newline :mandatory stream))
-    
-    (when partition-names
-      (pprint-logical-block (stream partition-names)
-        (format stream "Partitions:~2I")
-        (loop
-          (pprint-newline :mandatory stream)
-          (let ((partition-name (pprint-pop)))
-            (print-partition partition-name (gethash partition-name partitions) stream))
-          (pprint-exit-if-list-exhausted)))
-      (pprint-newline :mandatory stream)
-      (pprint-newline :mandatory stream))
-    
-    (maphash
-     #'(lambda (char char-or-partition)
-         (if (eql char char-or-partition)
-           (push char singletons)
-           (assert-type char-or-partition identifier)))
-     (lexer-char-tokens lexer))
-    (setq singletons (sort singletons #'char<))
-    (when singletons
-      (format stream "Singletons: ~@_~<~@{~W ~:_~}~:>~:@_~:@_" singletons))))
-    
-
-(defmethod print-object ((lexer lexer) stream)
-  (print-unreadable-object (lexer stream :identity t)
-    (write-string "lexer" stream)))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-
-
-; Return a freshly consed list of partitions for the given charclass.
-(defun charclass-partitions (lexer charclass)
-  (do ((partitions nil)
-       (charset (charclass-charset charclass)))
-      ((charset-empty? charset) partitions)
-    (let* ((partition-name (if (charset-infinite? charset)
-                             *default-partition-name*
-                             (gethash (charset-highest-char charset) (lexer-char-tokens lexer))))
-           (partition-charset (if (characterp partition-name)
-                                (char-charset partition-name)
-                                (partition-charset (gethash partition-name (lexer-partitions lexer))))))
-      (push partition-name partitions)
-      (setq charset (charset-difference charset partition-charset)))))
-
-
-; Return an updated grammar-source whose character class nonterminals are replaced with sets of
-; terminals inside :- and :-- constraints.
-(defun update-constraint-nonterminals (lexer grammar-source)
-  (mapcar
-   #'(lambda (production-source)
-       (let ((rhs (second production-source)))
-         (if (some #'(lambda (rhs-component)
-                       (and (consp rhs-component)
-                            (member (first rhs-component) '(:- :--))))
-                   rhs)
-           (list*
-            (first production-source)
-            (mapcar
-             #'(lambda (component)
-                 (when (consp component)
-                   (let ((tag (first component)))
-                     (when (eq tag ':-)
-                       (setq component (list* ':-- (rest component) (rest component)))
-                       (setq tag ':--))
-                     (when (eq tag ':--)
-                       (setq component
-                             (list* tag
-                                    (second component)
-                                    (mapcan #'(lambda (grammar-symbol)
-                                                (if (nonterminal? grammar-symbol)
-                                                  (charclass-partitions lexer (assert-non-null (lexer-charclass lexer grammar-symbol)))
-                                                  (list grammar-symbol)))
-                                            (cddr component)))))))
-                 component)
-             rhs)
-            (cddr production-source))
-           production-source)))
-   grammar-source))
-
-
-; Return two values:
-;   An updated grammar-source that includes:
-;     grammar productions that define the character class nonterminals out of characters and tokens;
-;     character class nonterminals replaced with sets of terminals inside :- and :-- constraints.
-;   Extra commands that:
-;     define the partitions used in this lexer;
-;     define the actions of these productions.
-(defun lexer-grammar-and-commands (lexer grammar-source)
-  (labels
-    ((component-partitions (charset partitions)
-       (if (charset-empty? charset)
-         partitions
-         (let* ((partition-name (if (charset-infinite? charset)
-                                  *default-partition-name*
-                                  (gethash (charset-highest-char charset) (lexer-char-tokens lexer))))
-                (partition (gethash partition-name (lexer-partitions lexer))))
-           (component-partitions (charset-difference charset (partition-charset partition))
-                                 (cons partition partitions))))))
-    (let ((productions nil)
-          (commands nil))
-      (dolist (charclass (lexer-charclasses lexer))
-        (unless (charclass-hidden charclass)
-          (let* ((nonterminal (charclass-nonterminal charclass))
-                 (nonterminal-source (general-grammar-symbol-source nonterminal))
-                 (production-prefix (if (consp nonterminal-source)
-                                      (format nil "~{~A~^-~}" nonterminal-source)
-                                      nonterminal-source))
-                 (production-number 0))
-            (dolist (action (charclass-actions charclass))
-              (let ((lexer-action (cdr action)))
-                (push (list 'declare-action (car action) nonterminal-source (lexer-action-type-expr lexer-action)) commands)))
-            (do ((charset (charclass-charset charclass)))
-                ((charset-empty? charset))
-              (let* ((partition-name (if (charset-infinite? charset)
-                                       *default-partition-name*
-                                       (gethash (charset-highest-char charset) (lexer-char-tokens lexer))))
-                     (partition-charset (if (characterp partition-name)
-                                          (char-charset partition-name)
-                                          (partition-charset (gethash partition-name (lexer-partitions lexer)))))
-                     (production-name (intern (format nil "~A-~D" production-prefix (incf production-number)))))
-                (push (list nonterminal-source (list partition-name) production-name nil) productions)
-                (dolist (action (charclass-actions charclass))
-                  (let* ((lexer-action (cdr action))
-                         (body (if (characterp partition-name)
-                                 (let* ((lexer-action-function (lexer-action-function lexer-action))
-                                        (result (funcall lexer-action-function partition-name)))
-                                   (typecase result
-                                     (integer result)
-                                     (character result)
-                                     ((eql nil) 'false)
-                                     ((eql t) 'true)
-                                     (t (error "Cannot infer the type of ~S's result ~S" lexer-action-function result))))
-                                 (list (lexer-action-name lexer-action) partition-name))))
-                    (push (list 'action (car action) production-name body nil) commands)))
-                (setq charset (charset-difference charset partition-charset)))))))
-      
-      (let ((partition-commands
-             (mapcan
-              #'(lambda (partition-name)
-                  (mapcan #'(lambda (lexer-action)
-                              (let ((lexer-action-name (lexer-action-name lexer-action)))
-                                (list
-                                 (list 'declare-action lexer-action-name partition-name (lexer-action-type-expr lexer-action))
-                                 (list 'terminal-action lexer-action-name partition-name (lexer-action-function lexer-action)))))
-                          (partition-lexer-actions (gethash partition-name (lexer-partitions lexer)))))
-              (lexer-partition-names lexer))))
-        (values
-         (nreconc productions (update-constraint-nonterminals lexer grammar-source))
-         (nconc partition-commands (nreverse commands)))))))
-
-
-; Make a lexer and grammar from the given source.
-; kind should be :lalr-1, :lr-1, or :canonical-lr-1.
-; charclasses-source is a list of character classes, and
-; lexer-actions-source is a list of lexer-action bindings; see make-lexer.
-; start-symbol is the grammar's start symbol, and grammar-source is its source.
-; Return two values:
-;   the lexer (including the grammar in its grammar field);
-;   list of extra commands that:
-;     define the partitions used in this lexer;
-;     define the actions of these productions.
-(defun make-lexer-and-grammar (kind charclasses-source lexer-actions-source parametrization start-symbol grammar-source &rest grammar-options)
-  (let ((lexer (make-lexer parametrization charclasses-source lexer-actions-source grammar-source)))
-    (multiple-value-bind (lexer-grammar-source extra-commands) (lexer-grammar-and-commands lexer grammar-source)
-      (let ((grammar (apply #'make-and-compile-grammar kind parametrization start-symbol lexer-grammar-source grammar-options)))
-        (setf (lexer-grammar lexer) grammar)
-        (values lexer extra-commands)))))
-
-
-; Parse the input string to produce a list of action results.
-; If trace is:
-;   nil,     don't print trace information
-;   :code,   print trace information, including action code
-;   other    print trace information
-; Return two values:
-;   the list of action results;
-;   the list of action results' types.
-(defun lexer-parse (lexer string &key trace)
-  (let ((in (coerce string 'list)))
-    (action-parse (lexer-grammar lexer) (lexer-classifier lexer) in :trace trace)))
-
-
-; Same as lexer-parse except that also print the action results nicely.
-(defun lexer-pparse (lexer string &key (stream t) trace)
-  (multiple-value-bind (results types) (lexer-parse lexer string :trace trace)
-    (print-values results types stream)
-    (terpri stream)
-    (values results types)))
-
-
-; Compute the lexer grammar's metagrammar.
-(defun set-up-lexer-metagrammar (lexer)
-  (setf (lexer-metagrammar lexer) (make-metagrammar (lexer-grammar lexer))))
-
-
-
-; Parse the input string into elements, where each element is the longest
-; possible string of input characters that is accepted by the grammar.
-; The grammar's terminals are all characters that may appear in the input
-; string plus the symbol $END which is inserted after the last character of
-; the string.
-; Return the list of lists of action results of the elements.
-;
-; If initial-state and state-transition are non-nil, the parser has state.
-; initial-state is a list of input symbols to be prepended to the input string
-; before the first element is parsed.  state-transition is a function that
-; takes the result of each successful action and produces two values:
-;   a modified result of that action;
-;   a list of input symbols to be prepended to the input string before the next
-;     element is parsed.
-;
-; If trace is:
-;   nil,     don't print trace information
-;   :code,   print trace information, including action code
-;   other    print trace information
-;
-; Return three values:
-;   the list of lists of action results;
-;   the list of action results' types.  Each of the lists of action results has
-;     this type signature.
-;   the last state
-(defun lexer-metaparse (lexer string &key initial-state state-transition trace)
-  (let ((metagrammar (lexer-metagrammar lexer)))
-    (do ((in (append (coerce string 'list) '($end)))
-         (results-lists nil))
-        ((endp in) (values (nreverse results-lists)
-                           (grammar-user-start-action-types (metagrammar-grammar metagrammar))
-                           initial-state))
-      (multiple-value-bind (results in-rest)
-                           (action-metaparse metagrammar (lexer-classifier lexer) (append initial-state in) :trace trace)
-        (when state-transition
-          (multiple-value-setq (results initial-state) (funcall state-transition results)))
-        (setq in in-rest)
-        (push results results-lists)))))
-
-
-; Same as lexer-metaparse except that also print the action results nicely.
-(defun lexer-pmetaparse (lexer string &key initial-state state-transition (stream t) trace)
-  (multiple-value-bind (results-lists types final-state)
-                       (lexer-metaparse lexer string :initial-state initial-state :state-transition state-transition :trace trace)
-    (pprint-logical-block (stream results-lists)
-      (pprint-exit-if-list-exhausted)
-      (loop
-        (print-values (pprint-pop) types stream :prefix "(" :suffix ")")
-        (pprint-exit-if-list-exhausted)
-        (format stream " ~_")))
-    (terpri stream)
-    (values results-lists types final-state)))
-

mozilla/js2/semantics/Main.lisp

@@ -1,89 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; ECMAScript semantic loader
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-#+allegro (shadow 'state)
-#+allegro (shadow 'type)
-#+lispworks (shadow 'define-action)
-#+lispworks (shadow 'type)
-
-(defparameter *semantic-engine-filenames*
-  '("Utilities" "Markup" "RTF" "HTML" "GrammarSymbol" "Grammar" "Parser" "Metaparser" "Lexer" "Calculus" "CalculusMarkup"))
-
-(defparameter *semantics-filenames*
-  '("JS20/Parser" "JS20/Lexer" "JS20/Units" "JS20/RegExp" "JS20/Kernel"))
-
-(defparameter *semantic-engine-directory*
-  (make-pathname
-   #+lispworks :host #+lispworks (pathname-host *load-truename*)
-   :directory (pathname-directory #-mcl *load-truename*
-                                  #+mcl (truename *loading-file-source-file*))))
-
-
-; Convert a filename string possibly containing slashes into a Lisp relative pathname.
-(defun filename-to-relative-pathname (filename)
-  (let ((directories nil))
-    (loop
-      (let ((slash (position #\/ filename)))
-        (if slash
-          (let ((dir-name (subseq filename 0 slash)))
-            (push (if (equal dir-name "..") :up dir-name) directories)
-            (setq filename (subseq filename (1+ slash))))
-          (return (if directories
-                    (make-pathname :directory (cons ':relative (nreverse directories)) :name filename #+lispworks :type #+lispworks "lisp")
-                    #-lispworks filename
-                    #+lispworks (make-pathname :name filename :type "lisp"))))))))
-
-
-; Convert a filename string possibly containing slashes relative to *semantic-engine-directory*
-; into a Lisp absolute pathname.
-(defun filename-to-semantic-engine-pathname (filename)
-  (merge-pathnames (filename-to-relative-pathname filename) *semantic-engine-directory*))
-
-
-(defun operate-on-files (f files &rest options)
-  (with-compilation-unit ()
-    (dolist (filename files)
-      (apply f (filename-to-semantic-engine-pathname filename) :verbose t options))))
-
-(defun compile-semantic-engine ()
-  (operate-on-files #'compile-file *semantic-engine-filenames* :load t))
-
-(defun load-semantic-engine ()
-  (operate-on-files #-allegro #'load #+allegro #'load-compiled *semantic-engine-filenames*))
-
-(defun load-semantics ()
-  (operate-on-files #-allegro #'load #+allegro #'load-compiled *semantics-filenames*))
-
-
-(defmacro with-local-output ((stream filename) &body body)
-  `(with-open-file (,stream (filename-to-semantic-engine-pathname ,filename)
-                            :direction :output
-                            :if-exists :supersede)
-     ,@body))
-
-
-(load-semantic-engine)
-(load-semantics)

mozilla/js2/semantics/Markup.lisp

@@ -1,700 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; Common RTF and HTML writing utilities
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-(defvar *trace-logical-blocks* nil)     ;Emit logical blocks to *trace-output* while processing
-(defvar *show-logical-blocks* nil)      ;Emit logical block boundaries as hidden rtf text
-
-(defvar *markup-logical-line-width* 90) ;Approximate maximum number of characters to display on a single logical line
-(defvar *average-space-width* 2/3)      ;Width of a space as a percentage of average character width when calculating logical line widths
-
-(defvar *external-link-base* nil)       ;URL prefix for referring to a page with external links or nil if none
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; LINK TABLES
-
-; Return a table for recording defined, referenced, and external links.
-; External links include a # character; locally defined and referenced ones do not.
-(declaim (inline make-link-table))
-(defun make-link-table ()
-  (make-hash-table :test #'equal))
-
-
-; The concatenation of link-prefix and link-name is the name of a link.  Mark the link defined.
-; Return the full name if links are allowed and this is the first definition of that name.
-; If duplicate is false, don't allow multiple definitions of the same link name.
-(defun record-link-definition (links link-prefix link-name duplicate)
-  (assert-type link-prefix string)
-  (assert-type link-name string)
-  (and links
-       (let ((name (concatenate 'string link-prefix link-name)))
-         (cond
-          ((not (eq (gethash name links) :defined))
-           (setf (gethash name links) :defined)
-           name)
-          (duplicate nil)
-          (t (warn "Duplicate link definition ~S" name)
-             name)))))
-
-
-; The concatenation of link-prefix and link-name is the name of a link.  Mark the link referenced.
-; If external is true, the link refers to the page given by *external-link-base*; if *external-link-base*
-; is null and external is true, no link gets made.
-; Return the full href if links are allowed or nil if not.
-(defun record-link-reference (links link-prefix link-name external)
-  (assert-type link-prefix string)
-  (assert-type link-name string)
-  (and links
-       (if external
-         (and *external-link-base*
-              (let ((href (concatenate 'string *external-link-base* "#" link-prefix link-name)))
-                (setf (gethash href links) :external)
-                href))
-         (let ((name (concatenate 'string link-prefix link-name)))
-           (unless (eq (gethash name links) :defined)
-             (setf (gethash name links) :referenced))
-           (concatenate 'string "#" name)))))
-
-
-; Warn about all referenced but not defined links.
-(defun warn-missing-links (links)
-  (when links
-    (let ((missing-links nil)
-          (external-links nil))
-      (maphash #'(lambda (name link-state)
-                   (case link-state
-                     (:referenced (push name missing-links))
-                     (:external (push name external-links))))
-               links)
-      (setq missing-links (sort missing-links #'string<))
-      (setq external-links (sort external-links #'string<))
-      (when missing-links
-        (warn "The following links have been referenced but not defined: ~S" missing-links))
-      (when external-links
-        (format *error-output* "External links:~%~{  ~A~%~}" external-links)))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; MARKUP ENVIRONMENTS
-
-
-(defstruct (markup-env (:constructor allocate-markup-env (macros widths)))
-  (macros nil :type hash-table :read-only t)     ;Hash table of keyword -> expansion list
-  (widths nil :type hash-table :read-only t)     ;Hash table of keyword -> estimated width of macro expansion;
-;                                                ;  zero-width entries can be omitted; multiline entries have t for a width.
-  (links nil :type (or null hash-table)))        ;Hash table of string -> either :referenced or :defined;
-;                                                ;  nil if links not supported
-
-
-; Make a markup-env.  If links is true, allow links.
-(defun make-markup-env (links)
-  (let ((markup-env (allocate-markup-env (make-hash-table :test #'eq) (make-hash-table :test #'eq))))
-    (when links
-      (setf (markup-env-links markup-env) (make-link-table)))
-    markup-env))
-
-
-; Recursively expand all keywords in markup-tree, producing a freshly consed expansion tree.
-; Allow keywords in the permitted-keywords list to be present in the output without generating an error.
-(defun markup-env-expand (markup-env markup-tree permitted-keywords)
-  (mapcan
-   #'(lambda (markup-element)
-       (cond
-        ((keywordp markup-element)
-         (let ((expansion (gethash markup-element (markup-env-macros markup-env) *get2-nonce*)))
-           (if (eq expansion *get2-nonce*)
-             (if (member markup-element permitted-keywords :test #'eq)
-               (list markup-element)
-               (error "Unknown markup macro ~S" markup-element))
-             (markup-env-expand markup-env expansion permitted-keywords))))
-        ((listp markup-element)
-         (list (markup-env-expand markup-env markup-element permitted-keywords)))
-        (t (list markup-element))))
-   markup-tree))
-
-
-(defun markup-env-define (markup-env keyword expansion &optional width)
-  (assert-type keyword keyword)
-  (assert-type expansion (list t))
-  (assert-type width (or null integer (eql t)))
-  (when (gethash keyword (markup-env-macros markup-env))
-    (warn "Redefining markup macro ~S" keyword))
-  (setf (gethash keyword (markup-env-macros markup-env)) expansion)
-  (if width
-    (setf (gethash keyword (markup-env-widths markup-env)) width)
-    (remhash keyword (markup-env-widths markup-env))))
-
-
-(defun markup-env-append (markup-env keyword expansion)
-  (assert-type keyword keyword)
-  (assert-type expansion (list t))
-  (setf (gethash keyword (markup-env-macros markup-env))
-        (append (gethash keyword (markup-env-macros markup-env)) expansion)))
-
-
-(defun markup-env-define-alist (markup-env keywords-and-expansions)
-  (dolist (keyword-and-expansion keywords-and-expansions)
-    (let ((keyword (car keyword-and-expansion))
-          (expansion (cdr keyword-and-expansion)))
-      (cond
-       ((not (consp keyword))
-        (markup-env-define markup-env keyword expansion))
-       ((eq (first keyword) '+)
-        (markup-env-append markup-env (second keyword) expansion))
-       (t (markup-env-define markup-env (first keyword) expansion (second keyword)))))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; LOGICAL POSITIONS
-
-(defstruct logical-position
-  (n-hard-breaks 0 :type integer)             ;Number of :new-line's in the current paragraph or logical block
-  (position 0 :type integer)                  ;Current character position.  If n-hard-breaks is zero, only includes characters written into this logical block
-  ;                                           ;  plus the minimal position from the enclosing block.  If n-hard-breaks is nonzero, includes indent and characters
-  ;                                           ;  written since the last hard break.
-  (surplus 0 :type integer)                   ;Value to subtract from position if soft breaks were hard breaks in this logical block
-  (n-soft-breaks nil :type (or null integer)) ;Number of soft-breaks in the current paragraph or nil if not inside a depict-logical-block
-  (indent 0 :type (or null integer)))         ;Indent for next line
-
-
-; Return the value the position would have if soft breaks became hard breaks in this logical block.
-(declaim (inline logical-position-minimal-position))
-(defun logical-position-minimal-position (logical-position)
-  (- (logical-position-position logical-position) (logical-position-surplus logical-position)))
-
-
-; Advance the logical position by width characters.  If width is t,
-; advance to the next line.
-(defun logical-position-advance (logical-position width)
-  (if (eq width t)
-    (progn
-      (incf (logical-position-n-hard-breaks logical-position))
-      (setf (logical-position-position logical-position) 0)
-      (setf (logical-position-surplus logical-position) 0))
-    (incf (logical-position-position logical-position) width)))
-
-
-(defstruct (soft-break (:constructor make-soft-break (width)))
-  (width 0 :type integer))     ;Number of spaces by which to replace this soft break if it doesn't turn into a hard break; t if unconditional
-
-
-; Destructively replace any soft-break that appears in a car position in the tree with
-; the spliced result of calling f on that soft-break.  f should return a non-null list that can
-; be nconc'd.
-(defun substitute-soft-breaks (tree f)
-  (do ((subtree tree next-subtree)
-       (next-subtree (cdr tree) (cdr next-subtree)))
-      ((endp subtree))
-    (let ((item (car subtree)))
-      (cond
-       ((soft-break-p item)
-        (let* ((splice (assert-non-null (funcall f item)))
-               (splice-rest (cdr splice)))
-          (setf (car subtree) (car splice))
-          (setf (cdr subtree) (nconc splice-rest next-subtree))))
-       ((consp item) (substitute-soft-breaks item f)))))
-  tree)
-
-
-; Destructively replace any soft-break that appears in a car position in the tree
-; with width spaces, where width is the soft-break's width.
-(defun remove-soft-breaks (tree)
-  (substitute-soft-breaks
-   tree
-   #'(lambda (soft-break)
-       (list (make-string (soft-break-width soft-break) :initial-element #\space :element-type #-mcl 'character #+mcl 'base-character)))))
-
-
-; Return a freshly consed markup list for a hard line break followed by indent spaces.
-(defun hard-break-markup (indent)
-  (if (zerop indent)
-    (list ':new-line)
-    (list ':new-line (make-string indent :initial-element #\space :element-type #-mcl 'character #+mcl 'base-character))))
-
-
-; Destructively replace any soft-break that appears in a car position in the tree
-; with a line break followed by indent spaces.
-(defun expand-soft-breaks (tree indent)
-  (substitute-soft-breaks
-   tree
-   #'(lambda (soft-break)
-       (declare (ignore soft-break))
-       (hard-break-markup indent))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; MARKUP STREAMS
-
-(defstruct (markup-stream (:copier nil) (:predicate markup-stream?))
-  (env nil :type markup-env :read-only t)
-  (level nil :type integer)           ;0 for emitting top-level group; 1 for emitting sections; 2 for emitting paragraphs; 3 for emitting paragraph contents
-  (head nil :type list)               ;Pointer to a dummy cons-cell whose cdr is the output markup list.
-  ;                                   ; A markup-stream may destructively modify any sublists of head that contain a soft-break.
-  (tail nil :type list)               ;Last cons cell of the output list; new cells are added in place to this cell's cdr; nil after markup-stream is closed.
-  (pretail nil :type list)            ;Tail's predecessor if tail's car is a block that can be inlined at the end of the output list; nil otherwise.
-  (logical-position nil :type logical-position)) ;Information about the current logical lines or nil if not emitting paragraph contents
-
-;                                                ;RTF                     ;HTML
-(defconstant *markup-stream-top-level* 0)        ;Top-level group         ;Top level
-(defconstant *markup-stream-section-level* 1)    ;Sections                ;(not used)
-(defconstant *markup-stream-paragraph-level* 2)  ;Paragraphs              ;Block tags
-(defconstant *markup-stream-content-level* 3)    ;Paragraph contents      ;Inline tags
-
-
-; Return the markup accumulated in the markup-stream.
-; The markup-stream is closed after this function is called.
-(defun markup-stream-unexpanded-output (markup-stream)
-  (when (markup-stream-pretail markup-stream)
-    ;Inline the last block at the end of the markup-stream.
-    (setf (cdr (markup-stream-pretail markup-stream)) (car (markup-stream-tail markup-stream)))
-    (setf (markup-stream-pretail markup-stream) nil))
-  (setf (markup-stream-tail markup-stream) nil) ;Close the stream.
-  (cdr (assert-non-null (markup-stream-head markup-stream))))
-
-
-; Return the markup accumulated in the markup-stream after expanding all of its macros.
-; The markup-stream is closed after this function is called.
-(defgeneric markup-stream-output (markup-stream))
-
-
-; Append one item to the end of the markup-stream.
-(defun markup-stream-append1 (markup-stream item)
-  (setf (markup-stream-pretail markup-stream) nil)
-  (let ((item-cons (list item)))
-    (setf (cdr (markup-stream-tail markup-stream)) item-cons)
-    (setf (markup-stream-tail markup-stream) item-cons)))
-
-
-; Return the approximate width of the markup item; return t if it is a line break.
-(defun markup-width (markup-stream item)
-  (cond
-   ((stringp item) (round (- (length item) (* (count #\space item) (- 1 *average-space-width*)))))
-   ((keywordp item) (gethash item (markup-env-widths (markup-stream-env markup-stream)) 0))
-   ((and item (symbolp item)) 0)
-   (t (error "Bad item in markup-width" item))))
-
-
-; Return the approximate width of the markup item; return t if it is a line break.
-; Also allow markup groups as long as they do not contain line breaks.
-(defgeneric markup-group-width (markup-stream item))
-
-
-; Append zero or more markup items to the end of the markup-stream.
-; The items must be either keywords, symbols, or strings.
-(defun depict (markup-stream &rest markup-list)
-  (assert-true (>= (markup-stream-level markup-stream) *markup-stream-content-level*))
-  (dolist (markup markup-list)
-    (markup-stream-append1 markup-stream markup)
-    (logical-position-advance (markup-stream-logical-position markup-stream) (markup-width markup-stream markup))))
-
-
-; Same as depict except that the items may be groups as well.
-(defun depict-group (markup-stream &rest markup-list)
-  (assert-true (>= (markup-stream-level markup-stream) *markup-stream-content-level*))
-  (dolist (markup markup-list)
-    (markup-stream-append1 markup-stream markup)
-    (logical-position-advance (markup-stream-logical-position markup-stream) (markup-group-width markup-stream markup))))
-
-
-; If markup-item-or-list is a list, emit its contents via depict.
-; If markup-item-or-list is not a list, emit it via depict.
-(defun depict-item-or-list (markup-stream markup-item-or-list)
-  (if (listp markup-item-or-list)
-    (apply #'depict markup-stream markup-item-or-list)
-    (depict markup-stream markup-item-or-list)))
-
-
-; If markup-item-or-list is a list, emit its contents via depict-group.
-; If markup-item-or-list is not a list, emit it via depict.
-(defun depict-item-or-group-list (markup-stream markup-item-or-list)
-  (if (listp markup-item-or-list)
-    (apply #'depict-group markup-stream markup-item-or-list)
-    (depict markup-stream markup-item-or-list)))
-
-
-; markup-stream must be a variable that names a markup-stream that is currently
-; accepting paragraphs.  Execute body with markup-stream bound to a markup-stream
-; to which the body can emit contents.  If non-null, the given block-style is applied to all
-; paragraphs emitted by body (in the HTML emitter only; RTF has no block styles).
-; If flatten is true, do not emit the style if it is already in effect from a surrounding block
-; or if its contents are empty.
-; Return the result value of body.
-(defmacro depict-block-style ((markup-stream block-style &optional flatten) &body body)
-  `(depict-block-style-f ,markup-stream ,block-style ,flatten
-                         #'(lambda (,markup-stream) ,@body)))
-
-(defgeneric depict-block-style-f (markup-stream block-style flatten emitter))
-
-
-; markup-stream must be a variable that names a markup-stream that is currently
-; accepting paragraphs.  Emit a paragraph with the given paragraph-style (which
-; must be a symbol) whose contents are emitted by body.  When executing body,
-; markup-stream is bound to a markup-stream to which body should emit the paragraph's contents.
-; Return the result value of body.
-(defmacro depict-paragraph ((markup-stream paragraph-style) &body body)
-  `(depict-paragraph-f ,markup-stream ,paragraph-style
-                       #'(lambda (,markup-stream) ,@body)))
-
-(defgeneric depict-paragraph-f (markup-stream paragraph-style emitter))
-
-
-; markup-stream must be a variable that names a markup-stream that is currently
-; accepting paragraph contents.  Execute body with markup-stream bound to a markup-stream
-; to which the body can emit contents.  If non-null, the given char-style is applied to all such
-; contents emitted by body.
-; Return the result value of body.
-(defmacro depict-char-style ((markup-stream char-style) &body body)
-  `(depict-char-style-f ,markup-stream ,char-style
-                        #'(lambda (,markup-stream) ,@body)))
-
-(defgeneric depict-char-style-f (markup-stream char-style emitter))
-
-
-; Ensure that the given style is not currently in effect in the markup-stream.
-; RTF streams don't currently keep track of styles, so this function does nothing for RTF streams.
-(defgeneric ensure-no-enclosing-style (markup-stream style))
-
-
-; Return a value that captures the current sequence of enclosing block styles.
-(defgeneric save-block-style (markup-stream))
-
-; markup-stream must be a variable that names a markup-stream that is currently
-; accepting paragraphs.  Execute body with markup-stream bound to a markup-stream
-; to which the body can emit contents.  The given saved-block-style is applied to all
-; paragraphs emitted by body (in the HTML emitter only; RTF has no block styles).
-; saved-block-style should have been obtained from a past call to save-block-style.
-; If flatten is true, do not emit the style if it is already in effect from a surrounding block
-; or if its contents are empty.
-; Return the result value of body.
-(defmacro with-saved-block-style ((markup-stream saved-block-style &optional flatten) &body body)
-  `(with-saved-block-style-f ,markup-stream ,saved-block-style ,flatten
-     #'(lambda (,markup-stream) ,@body)))
-
-(defgeneric with-saved-block-style-f (markup-stream saved-block-style flatten emitter))
-
-
-; Depict an anchor.  The concatenation of link-prefix and link-name must be a string
-; suitable for an anchor name.
-; If duplicate is true, allow duplicate calls for the same link-name, in which case only
-; the first one takes effect.
-(defgeneric depict-anchor (markup-stream link-prefix link-name duplicate))
-
-
-; markup-stream must be a variable that names a markup-stream that is currently
-; accepting paragraph contents.  Execute body with markup-stream bound to a markup-stream
-; to which the body can emit contents.  The given link name is the destination of a local
-; link for which body is the contents.  The concatenation of link-prefix and link-name
-; must be a string suitable for an anchor name.
-; Return the result value of body.
-(defmacro depict-link-reference ((markup-stream link-prefix link-name external) &body body)
-  `(depict-link-reference-f ,markup-stream ,link-prefix ,link-name ,external
-                            #'(lambda (,markup-stream) ,@body)))
-
-(defgeneric depict-link-reference-f (markup-stream link-prefix link-name external emitter))
-
-
-; markup-stream must be a variable that names a markup-stream that is currently
-; accepting paragraph contents.  Execute body with markup-stream bound to a markup-stream
-; to which the body can emit contents.  Depending on link, do one of the following:
-;   :reference   Emit a reference to the link with the given body of the reference;
-;   :external    Emit an external reference to the link with the given body of the reference;
-;   :definition  Emit the link as an anchor, followed by the body;
-;   nil          Emit the body only.
-; If duplicate is true, allow duplicate anchors, in which case only the first one takes effect.
-; Return the result value of body.
-(defmacro depict-link ((markup-stream link link-prefix link-name duplicate) &body body)
-  `(depict-link-f ,markup-stream ,link ,link-prefix ,link-name ,duplicate
-                  #'(lambda (,markup-stream) ,@body)))
-
-(defun depict-link-f (markup-stream link link-prefix link-name duplicate emitter)
-  (ecase link
-    (:reference (depict-link-reference-f markup-stream link-prefix link-name nil emitter))
-    (:external (depict-link-reference-f markup-stream link-prefix link-name t emitter))
-    (:definition
-      (depict-anchor markup-stream link-prefix link-name duplicate)
-      (funcall emitter markup-stream))
-    ((nil) (funcall emitter markup-stream))))
-
-
-(defun depict-logical-block-f (markup-stream indent emitter)
-  (assert-true (>= (markup-stream-level markup-stream) *markup-stream-content-level*))
-  (if indent
-    (let* ((logical-position (markup-stream-logical-position markup-stream))
-           (cumulative-indent (+ (logical-position-indent logical-position) indent))
-           (minimal-position (logical-position-minimal-position logical-position))
-           (inner-logical-position (make-logical-position :position minimal-position
-                                                          :n-soft-breaks 0
-                                                          :indent cumulative-indent))
-           (old-tail (markup-stream-tail markup-stream)))
-      (setf (markup-stream-logical-position markup-stream) inner-logical-position)
-      (when *show-logical-blocks*
-        (markup-stream-append1 markup-stream (list ':invisible (format nil "<~D" indent))))
-      (prog1
-        (funcall emitter markup-stream)
-        (when *show-logical-blocks*
-          (markup-stream-append1 markup-stream '(:invisible ">")))
-        (assert-true (eq (markup-stream-logical-position markup-stream) inner-logical-position))
-        (let* ((tree (cdr old-tail))
-               (inner-position (logical-position-position inner-logical-position))
-               (inner-count (- inner-position minimal-position))
-               (inner-n-hard-breaks (logical-position-n-hard-breaks inner-logical-position))
-               (inner-n-soft-breaks (logical-position-n-soft-breaks inner-logical-position)))
-          (when *trace-logical-blocks*
-            (format *trace-output* "Block ~:W:~%position ~D,  count ~D,  n-hard-breaks ~D,  n-soft-breaks ~D~%~%"
-                    tree inner-position inner-count inner-n-hard-breaks inner-n-soft-breaks))
-          (cond
-           ((zerop inner-n-soft-breaks)
-            (assert-true (zerop (logical-position-surplus inner-logical-position)))
-            (if (zerop inner-n-hard-breaks)
-              (incf (logical-position-position logical-position) inner-count)
-              (progn
-                (incf (logical-position-n-hard-breaks logical-position) inner-n-hard-breaks)
-                (setf (logical-position-position logical-position) inner-position)
-                (setf (logical-position-surplus logical-position) 0))))
-           ((and (zerop inner-n-hard-breaks) (<= inner-position *markup-logical-line-width*))
-            (assert-true tree)
-            (remove-soft-breaks tree)
-            (incf (logical-position-position logical-position) inner-count))
-           (t
-            (assert-true tree)
-            (expand-soft-breaks tree cumulative-indent)
-            (incf (logical-position-n-hard-breaks logical-position) (+ inner-n-hard-breaks inner-n-soft-breaks))
-            (setf (logical-position-position logical-position) (logical-position-minimal-position inner-logical-position))
-            (setf (logical-position-surplus logical-position) 0))))
-        (setf (markup-stream-logical-position markup-stream) logical-position)))
-    (funcall emitter markup-stream)))
-
-
-; markup-stream must be a variable that names a markup-stream that is currently
-; accepting paragraph contents.  Execute body with markup-stream bound to a markup-stream
-; to which the body can emit contents.  body can call depict-break, which will either
-; all expand to the widths given to the depict-break calls or all expand to line breaks
-; followed by indents to the current indent level plus the given indent.
-; If indent is nil, don't create the logical block and just evaluate body.
-; Return the result value of body.
-(defmacro depict-logical-block ((markup-stream indent) &body body)
-  `(depict-logical-block-f ,markup-stream ,indent
-                           #'(lambda (,markup-stream) ,@body)))
-
-
-; Emit a conditional line break.  If the line break is not needed, emit width spaces instead.
-; If width is t or omitted, the line break is unconditional.
-; If width is nil, do nothing.
-; If the line break is needed, the new line is indented to the current indent level.
-; Must be called from the dynamic scope of a depict-logical-block.
-(defun depict-break (markup-stream &optional (width t))
-  (assert-true (>= (markup-stream-level markup-stream) *markup-stream-content-level*))
-  (when width
-    (let* ((logical-position (markup-stream-logical-position markup-stream))
-           (indent (logical-position-indent logical-position)))
-      (if (eq width t)
-        (depict-item-or-list markup-stream (hard-break-markup indent))
-        (progn
-          (incf (logical-position-n-soft-breaks logical-position))
-          (incf (logical-position-position logical-position) width)
-          (let ((surplus (- (logical-position-position logical-position) (round (* indent *average-space-width*)))))
-            (when (< surplus 0)
-              (setq surplus 0))
-            (setf (logical-position-surplus logical-position) surplus))
-          (when *show-logical-blocks*
-            (markup-stream-append1 markup-stream '(:invisible :bullet)))
-          (markup-stream-append1 markup-stream (make-soft-break width)))))))
-
-
-; Call emitter to emit each element of the given list onto the markup-stream.
-; emitter takes two arguments -- the markup-stream and the element of list to be emitted.
-; Emit prefix before the list and suffix after the list.  If prefix-break is supplied, call
-; depict-break with it as the argument after the prefix.
-; If indent is non-nil, enclose the list elements in a logical block with the given indent.
-; Emit separator between any two emitted elements.  If break is supplied, call
-; depict-break with it as the argument after each separator.
-; If the list is empty, emit empty unless it is :error, in which case signal an error.
-;
-; prefix, suffix, separator, and empty should be lists of markup elements appropriate for depict.
-; If any of these lists has only one element that is not itself a list, then that list can be
-; abbreviated to just that element (as in depict-item-or-list).
-;
-(defun depict-list (markup-stream emitter list &key indent prefix prefix-break suffix separator break (empty :error))
-  (assert-true (or indent (not (or prefix-break break))))
-  (labels
-    ((emit-element (markup-stream list)
-       (funcall emitter markup-stream (first list))
-       (let ((rest (rest list)))
-         (when rest
-           (depict-item-or-list markup-stream separator)
-           (depict-break markup-stream break)
-           (emit-element markup-stream rest)))))
-    
-    (depict-item-or-list markup-stream prefix)
-    (cond
-     (list
-      (depict-logical-block (markup-stream indent)
-        (depict-break markup-stream prefix-break)
-        (emit-element markup-stream list)))
-     ((eq empty ':error) (error "Non-empty list required"))
-     (t (depict-item-or-list markup-stream empty)))
-    (depict-item-or-list markup-stream suffix)))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; MARKUP FOR CHARACTERS AND STRINGS
-
-(defparameter *character-names*
-  '((#x00 . "NUL")
-    (#x08 . "BS")
-    (#x09 . "TAB")
-    (#x0A . "LF")
-    (#x0B . "VT")
-    (#x0C . "FF")
-    (#x0D . "CR")
-    (#x20 . "SP")))
-
-; Emit markup for the given character.  The character is emitted without any formatting if it is a
-; printable character and not a member of the escape-list list of characters.  Otherwise the
-; character is emitted with :character-literal-control formatting.
-; The markup-stream should already be set to :character-literal formatting.
-(defun depict-character (markup-stream char &optional (escape-list '(#\space)))
-  (let ((code (char-code char)))
-    (if (and (>= code 32) (< code 127) (not (member char escape-list)))
-      (depict markup-stream (string char))
-      (depict-char-style (markup-stream ':character-literal-control)
-        (let ((name (or (cdr (assoc code *character-names*))
-                        (format nil "u~4,'0X" code))))
-          (depict markup-stream ':left-angle-quote name ':right-angle-quote))))))
-
-
-; Emit markup for the given string, enclosing it in curly double quotes.
-; The markup-stream should be set to normal formatting.
-(defun depict-string (markup-stream string)
-  (depict markup-stream ':left-double-quote)
-  (unless (equal string "")
-    (depict-char-style (markup-stream ':character-literal)
-      (dotimes (i (length string))
-        (depict-character markup-stream (char string i) nil))))
-  (depict markup-stream ':right-double-quote))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; IDENTIFIER ABBREVIATIONS
-
-; Return a symbol with the same package as the given symbol but whose name omits everything
-; after the first underscore, if any, in the given symbol's name.  The returned symbol is eq
-; to the given symbol if its name contains no underscores.
-(defun symbol-to-abbreviation (symbol)
-  (let* ((name (symbol-name symbol))
-         (pos (position #\_ name)))
-    (if pos
-      (intern (subseq name 0 pos) (symbol-package symbol))
-      symbol)))
-
-
-; A caching version of symbol-to-abbreviation.
-(defun symbol-abbreviation (symbol)
-  (or (get symbol :abbreviation)
-      (setf (get symbol :abbreviation) (symbol-to-abbreviation symbol))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; MARKUP FOR IDENTIFIERS
-
-; Return string converted from dash-separated-uppercase-words to mixed case,
-; with the first character capitalized if capitalize is true.
-; The string should contain only letters, dashes, and numbers.
-(defun string-to-mixed-case (string &optional capitalize)
-  (let* ((length (length string))
-         (dst-string (make-array length :element-type #-mcl 'character #+mcl 'base-character :fill-pointer 0)))
-    (dotimes (i length)
-      (let ((char (char string i)))
-        (if (eql char #\-)
-          (if capitalize
-            (error "Double capitalize")
-            (setq capitalize t))
-          (progn
-            (cond
-             ((upper-case-p char)
-              (if capitalize
-                (setq capitalize nil)
-                (setq char (char-downcase char))))
-             ((digit-char-p char))
-             ((member char '(#\$ #\_)))
-             (t (error "Bad string-to-mixed-case character ~A" char)))
-            (vector-push char dst-string)))))
-    dst-string))
-
-
-; Return a string containing the symbol's name in mixed case with the first letter capitalized.
-(defun symbol-upper-mixed-case-name (symbol)
-  (or (get symbol :upper-mixed-case-name)
-      (setf (get symbol :upper-mixed-case-name) (string-to-mixed-case (symbol-name symbol) t))))
-
-
-; Return a string containing the symbol's name in mixed case with the first letter in lower case.
-(defun symbol-lower-mixed-case-name (symbol)
-  (or (get symbol :lower-mixed-case-name)
-      (setf (get symbol :lower-mixed-case-name) (string-to-mixed-case (symbol-name symbol)))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; MISCELLANEOUS MARKUP
-
-
-; Append a space to the end of the markup-stream.
-(defun depict-space (markup-stream)
-  (depict markup-stream " "))
-
-
-; Emit markup for the given integer, displaying it in decimal.
-(defun depict-integer (markup-stream i)
-  (depict markup-stream (format nil "~D" i)))
-
-
-(defmacro styled-text-depictor (symbol)
-  `(get ,symbol 'styled-text-depictor))
-
-
-; Emit markup for the given <text>, which should be a list of:
-;   <string>                display as is
-;   <keyword>               display as is
-;   (<symbol> . <args>)     if <symbol>'s styled-text-depictor property is present, call it giving it <args>
-;                             as arguments; otherwise treat this case as the following:
-;   (<style> . <text>)      display <text> with the given <style> keyword
-;   <character>             display using depict-character
-(defun depict-styled-text (markup-stream text)
-  (dolist (item text)
-    (cond
-     ((or (stringp item) (keywordp item))
-      (depict markup-stream item))
-     ((consp item)
-      (let* ((first (first item))
-             (rest (rest item))
-             (depictor (styled-text-depictor first)))
-        (if depictor
-          (apply depictor markup-stream rest)
-          (depict-char-style (markup-stream first)
-            (depict-styled-text markup-stream rest)))))
-     ((characterp item)
-      (depict-character markup-stream item))
-     (t (error "Bad depict-styled-text item: ~S" item)))))

mozilla/js2/semantics/Metaparser.lisp

@@ -1,360 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; Finite-state machine generator
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; METATRANSITION
-
-(defstruct (metatransition (:constructor make-metatransition (next-metastate pre-productions post-productions)))
-  (next-metastate nil :read-only t)     ;Next metastate to enter or nil if this is an accept transition
-  (pre-productions nil :read-only t)    ;List of productions reduced by this transition (in order from first to last) before the shift
-  (post-productions nil :read-only t))  ;List of productions reduced by this transition (in order from first to last) after the shift
-
-  
-;;; ------------------------------------------------------------------------------------------------------
-;;; METASTATE
-
-;;; A metastate is a list of states that represents a possible stack that the
-;;; LALR(1) parser may encounter.
-(defstruct (metastate (:constructor make-metastate (stack number transitions)))
-  (stack nil :type list :read-only t)                 ;List of states that comprises a possible stack
-  (number nil :type integer :read-only t)             ;Serial number of this metastate
-  (transitions nil :type simple-vector :read-only t)) ;Array, indexed by terminal numbers, of either nil or metatransition structures
-
-(declaim (inline metastate-transition))
-(defun metastate-transition (metastate terminal-number)
-  (svref (metastate-transitions metastate) terminal-number))
-
-
-(defun print-metastate (metastate metagrammar &optional (stream t))
-  (let ((grammar (metagrammar-grammar metagrammar)))
-    (pprint-logical-block (stream nil)
-      (format stream "M~D:~2I ~@_~<~@{S~D ~:_~}~:>~:@_"
-              (metastate-number metastate)
-              (nreverse (mapcar #'state-number (metastate-stack metastate))))
-      (let ((transitions (metastate-transitions metastate)))
-        (dotimes (terminal-number (length transitions))
-          (let ((transition (svref transitions terminal-number))
-                (terminal (svref (grammar-terminals grammar) terminal-number)))
-            (when transition
-              (let ((next-metastate (metatransition-next-metastate transition)))
-                (pprint-logical-block (stream nil)
-                  (format stream "~W ==> ~@_~:I~:[accept~;M~:*~D~] ~_"
-                          terminal
-                          (and next-metastate (metastate-number next-metastate)))
-                  (pprint-fill stream (mapcar #'production-name (metatransition-pre-productions transition)))
-                  (format stream " ~@_")
-                  (pprint-fill stream (mapcar #'production-name (metatransition-post-productions transition))))
-                (pprint-newline :mandatory stream)))))))))
-
-
-(defmethod print-object ((metastate metastate) stream)
-  (print-unreadable-object (metastate stream)
-    (format stream "metastate S~D" (metastate-number metastate))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; METAGRAMMAR
-
-(defstruct (metagrammar (:constructor allocate-metagrammar))
-  (grammar nil :type grammar :read-only t)          ;The grammar to which this metagrammar corresponds
-  (metastates nil :type list :read-only t)          ;List of metastates ordered by metastate numbers
-  (start nil :type metastate :read-only t))         ;The start metastate
-
-
-(defun make-metagrammar (grammar)
-  (let* ((terminals (grammar-terminals grammar))
-         (n-terminals (length terminals))
-         (metastates-hash (make-hash-table :test #'equal))    ;Hash table of (list of state) -> metastate
-         (metastates nil)
-         (metastate-number -1))
-    (labels
-      (;Return the stack after applying the given reduction production.
-       (apply-reduction-production (stack production)
-         (let* ((stack (nthcdr (production-rhs-length production) stack))
-                (state (first stack))
-                (dst-state (assert-non-null
-                            (cdr (assoc (production-lhs production) (state-gotos state) :test *grammar-symbol-=*))))
-                (dst-stack (cons dst-state stack)))
-           (if (member dst-state stack :test #'eq)
-             (error "This grammar cannot be represented by a FSM.  Stack: ~S" dst-stack)
-             dst-stack)))
-       
-       (get-metatransition (stack terminal productions)
-         (let* ((state (first stack))
-                (transition (cdr (assoc terminal (state-transitions state) :test *grammar-symbol-=*))))
-           (when transition
-             (case (transition-kind transition)
-               (:shift
-                (multiple-value-bind (metastate forwarding-productions) (get-metastate (transition-state transition) stack t)
-                  (make-metatransition metastate (nreverse productions) forwarding-productions)))
-               (:reduce
-                (let ((production (transition-production transition)))
-                  (get-metatransition (apply-reduction-production stack production) terminal (cons production productions))))
-               (:accept (make-metatransition nil (nreverse productions) nil))
-               (t (error "Bad transition: ~S" transition))))))
-       
-       ;Return the metastate corresponding to the state stack (stack-top . stack-rest).  Construct a new
-       ;metastate if necessary.
-       ;If simplify is true and stack-top is a state for which every outgoing transition is the same
-       ;reduction, return two values:
-       ;  the metastate reached by following that reduction (doing it recursively if needed)
-       ;  a list of reduction productions followed this way.
-       (get-metastate (stack-top stack-rest simplify)
-         (let* ((stack (cons stack-top stack-rest))
-                (existing-metastate (gethash stack metastates-hash)))
-           (cond
-            (existing-metastate (values existing-metastate nil))
-            ((member stack-top stack-rest :test #'eq)
-             (error "This grammar cannot be represented by a FSM.  Stack: ~S" stack))
-            (t (let ((forwarding-production (and simplify (forwarding-state-production stack-top))))
-                 (if forwarding-production
-                   (let ((stack (apply-reduction-production stack forwarding-production)))
-                     (multiple-value-bind (metastate forwarding-productions) (get-metastate (car stack) (cdr stack) simplify)
-                       (values metastate (cons forwarding-production forwarding-productions))))
-                   (let* ((transitions (make-array n-terminals :initial-element nil))
-                          (metastate (make-metastate stack (incf metastate-number) transitions)))
-                     (setf (gethash stack metastates-hash) metastate)
-                     (push metastate metastates)
-                     (dotimes (n n-terminals)
-                       (setf (svref transitions n)
-                             (get-metatransition stack (svref terminals n) nil)))
-                     (values metastate nil)))))))))
-      
-      (let ((start-metastate (get-metastate (grammar-start-state grammar) nil nil)))
-        (allocate-metagrammar :grammar grammar
-                              :metastates (nreverse metastates)
-                              :start start-metastate)))))
-
-
-; Print the metagrammar nicely.
-(defun print-metagrammar (metagrammar &optional (stream t) &key (grammar t) (details t))
-  (pprint-logical-block (stream nil)
-    (when grammar
-      (print-grammar (metagrammar-grammar metagrammar) stream :details details))
-    
-    ;Print the metastates.
-    (format stream "Start metastate: ~@_M~D~:@_~:@_" (metastate-number (metagrammar-start metagrammar)))
-    (pprint-logical-block (stream (metagrammar-metastates metagrammar))
-      (pprint-exit-if-list-exhausted)
-      (format stream "Metastates:~2I~:@_")
-      (loop
-        (print-metastate (pprint-pop) metagrammar stream)
-        (pprint-exit-if-list-exhausted)
-        (pprint-newline :mandatory stream))))
-  (pprint-newline :mandatory stream))
-
-
-(defmethod print-object ((metagrammar metagrammar) stream)
-  (print-unreadable-object (metagrammar stream :identity t)
-    (write-string "metagrammar" stream)))
-
-
-; Find the longest possible prefix of the input list of tokens that is accepted by the
-; grammar.  Parse that prefix and return two values:
-;   the list of action results;
-;   the tail of the input list of tokens remaining to be parsed.
-; Signal an error if no prefix of the input list is accepted by the grammar.
-;
-; token-terminal is a function that returns a terminal symbol when given an input token.
-; If trace is:
-;   nil,     don't print trace information
-;   :code,   print trace information, including action code
-;   other    print trace information
-(defun action-metaparse (metagrammar token-terminal input &key trace)
-  (if trace
-    (trace-action-metaparse metagrammar token-terminal input trace)
-    (let ((grammar (metagrammar-grammar metagrammar)))
-      (labels
-        ((transition-value-stack (value-stack productions)
-           (dolist (production productions)
-             (setq value-stack (funcall (production-evaluator production) value-stack)))
-           value-stack)
-         
-         (cut (input good-metastate good-input good-value-stack)
-           (unless good-metastate
-             (error "Parse error on ~S ..." (ldiff input (nthcdr 10 input))))
-           (let ((last-metatransition (metastate-transition good-metastate *end-marker-terminal-number*)))
-             (assert-true (null (metatransition-next-metastate last-metatransition)))
-             (assert-true (null (metatransition-post-productions last-metatransition)))
-             (values
-              (reverse (transition-value-stack good-value-stack (metatransition-pre-productions last-metatransition)))
-              good-input))))
-        
-        (do ((metastate (metagrammar-start metagrammar))
-             (input input (cdr input))
-             (value-stack nil)
-             (last-good-metastate nil)
-             last-good-input
-             last-good-value-stack)
-            (nil)
-          (when (metastate-transition metastate *end-marker-terminal-number*)
-            (setq last-good-metastate metastate)
-            (setq last-good-input input)
-            (setq last-good-value-stack value-stack))
-          (when (endp input)
-            (return (cut input last-good-metastate last-good-input last-good-value-stack)))
-          (let* ((token (first input))
-                 (terminal (funcall token-terminal token))
-                 (terminal-number (terminal-number grammar terminal))
-                 (metatransition (metastate-transition metastate terminal-number)))
-            (unless metatransition
-              (return (cut input last-good-metastate last-good-input last-good-value-stack)))
-            (setq value-stack (transition-value-stack value-stack (metatransition-pre-productions metatransition)))
-            (dolist (action-function-binding (gethash terminal (grammar-terminal-actions grammar)))
-              (push (funcall (cdr action-function-binding) token) value-stack))
-            (setq value-stack (transition-value-stack value-stack (metatransition-post-productions metatransition)))
-            (setq metastate (metatransition-next-metastate metatransition))))))))
-
-
-; Same as action-parse, but with tracing information
-; If trace is:
-;   :code,   print trace information, including action code
-;   other    print trace information
-(defun trace-action-metaparse (metagrammar token-terminal input trace)
-  (let
-    ((grammar (metagrammar-grammar metagrammar)))
-    (labels
-      ((print-stacks (value-stack type-stack)
-         (write-string "    " *trace-output*)
-         (if value-stack
-           (print-values (reverse value-stack) (reverse type-stack) *trace-output*)
-           (write-string "empty" *trace-output*))
-         (pprint-newline :mandatory *trace-output*))
-       
-       (transition-value-stack (value-stack type-stack productions)
-         (dolist (production productions)
-           (write-string "  reduce " *trace-output*)
-           (if (eq trace :code)
-             (write production :stream *trace-output* :pretty t)
-             (print-production production *trace-output*))
-           (pprint-newline :mandatory *trace-output*)
-           (setq value-stack (funcall (production-evaluator production) value-stack))
-           (setq type-stack (nthcdr (production-n-action-args production) type-stack))
-           (dolist (action-signature (grammar-symbol-signature grammar (production-lhs production)))
-             (push (cdr action-signature) type-stack))
-           (print-stacks value-stack type-stack))
-         (values value-stack type-stack))
-       
-       (cut (input good-metastate good-input good-value-stack good-type-stack)
-         (unless good-metastate
-           (error "Parse error on ~S ..." (ldiff input (nthcdr 10 input))))
-         (let ((last-metatransition (metastate-transition good-metastate *end-marker-terminal-number*)))
-           (assert-true (null (metatransition-next-metastate last-metatransition)))
-           (assert-true (null (metatransition-post-productions last-metatransition)))
-           (format *trace-output* "cut to M~D~:@_" (metastate-number good-metastate))
-           (print-stacks good-value-stack good-type-stack)
-           (pprint-newline :mandatory *trace-output*)
-           (values
-            (reverse (transition-value-stack good-value-stack good-type-stack (metatransition-pre-productions last-metatransition)))
-            good-input))))
-      
-      (do ((metastate (metagrammar-start metagrammar))
-           (input input (cdr input))
-           (value-stack nil)
-           (type-stack nil)
-           (last-good-metastate nil)
-           last-good-input
-           last-good-value-stack
-           last-good-type-stack)
-          (nil)
-        (format *trace-output* "M~D" (metastate-number metastate))
-        (when (metastate-transition metastate *end-marker-terminal-number*)
-          (write-string " (good)" *trace-output*)
-          (setq last-good-metastate metastate)
-          (setq last-good-input input)
-          (setq last-good-value-stack value-stack)
-          (setq last-good-type-stack type-stack))
-        (write-string ": " *trace-output*)
-        (when (endp input)
-          (return (cut input last-good-metastate last-good-input last-good-value-stack last-good-type-stack)))
-        (let* ((token (first input))
-               (terminal (funcall token-terminal token))
-               (terminal-number (terminal-number grammar terminal))
-               (metatransition (metastate-transition metastate terminal-number)))
-          (unless metatransition
-            (format *trace-output* "shift ~W: " terminal)
-            (return (cut input last-good-metastate last-good-input last-good-value-stack last-good-type-stack)))
-          (format *trace-output* "transition to M~D~:@_" (metastate-number (metatransition-next-metastate metatransition)))
-          (multiple-value-setq (value-stack type-stack)
-            (transition-value-stack value-stack type-stack (metatransition-pre-productions metatransition)))
-          (dolist (action-function-binding (gethash terminal (grammar-terminal-actions grammar)))
-            (push (funcall (cdr action-function-binding) token) value-stack))
-          (dolist (action-signature (grammar-symbol-signature grammar terminal))
-            (push (cdr action-signature) type-stack))
-          (format *trace-output* "shift ~W~:@_" terminal)
-          (print-stacks value-stack type-stack)
-          (multiple-value-setq (value-stack type-stack)
-            (transition-value-stack value-stack type-stack (metatransition-post-productions metatransition)))
-          (setq metastate (metatransition-next-metastate metatransition)))))))
-
-
-; Compute all representative strings of terminals such that, for each such string S:
-;   S is rejected by the grammar's language;
-;   all prefixes of S are also rejected by the grammar's language;
-;   for any S and all strings of terminals T, the concatenated string ST is also
-;     rejected by the grammar's language;
-;   no string S1 is a prefix of (or equal to) another string S2.
-; Often there are infinitely many such strings S, so only output one for each illegal
-; metaparser transition.
-; Return a list of S's, where each S is itself a list of terminals.
-(defun compute-illegal-strings (metagrammar)
-  (let* ((grammar (metagrammar-grammar metagrammar))
-         (terminals (grammar-terminals grammar))
-         (n-terminals (length terminals))
-         (metastates (metagrammar-metastates metagrammar))
-         (n-metastates (length metastates))
-         (visited-metastates (make-array n-metastates :element-type 'bit :initial-element 0))
-         (illegal-strings nil))
-    (labels
-      ((visit (metastate reversed-string)
-         (let ((metastate-number (metastate-number metastate)))
-           (when (= (sbit visited-metastates metastate-number) 0)
-             (setf (sbit visited-metastates metastate-number) 1)
-             (let ((metatransitions (metastate-transitions metastate)))
-               ;If there is a transition for the end marker from this state, then string
-               ;is accepted by the language, so cut off the search.
-               (unless (svref metatransitions *end-marker-terminal-number*)
-                 (dotimes (terminal-number n-terminals)
-                   (unless (= terminal-number *end-marker-terminal-number*)
-                     (let ((metatransition (svref metatransitions terminal-number))
-                           (reversed-string (cons (svref terminals terminal-number) reversed-string)))
-                       (if metatransition
-                         (visit (metatransition-next-metastate metatransition) reversed-string)
-                         (push (reverse reversed-string) illegal-strings)))))))))))
-      
-      (visit (metagrammar-start metagrammar) nil)
-      (nreverse illegal-strings))))
-
-
-; Compute and print illegal strings of terminals.  See compute-illegal-strings.
-(defun print-illegal-strings (metagrammar &optional (stream t))
-  (pprint-logical-block (stream (compute-illegal-strings metagrammar))
-    (format stream "Illegal strings:~2I")
-    (loop
-      (pprint-exit-if-list-exhausted)
-      (pprint-newline :mandatory stream)
-      (pprint-fill stream (pprint-pop))))
-  (pprint-newline :mandatory stream))

mozilla/js2/semantics/Parser.lisp

@@ -1,837 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; LALR(1) and LR(1) grammar generator
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-;;; ------------------------------------------------------------------------------------------------------
-
-; kernel-item-alist is a list of pairs (item . prev), where item is a kernel item
-; and prev is either nil or a laitem.  kernel is a list of the kernel items in a canonical order.
-; Return a new state with the given list of kernel items and state number.
-; If mode is :lalr-1, for each non-null prev in kernel-item-alist, update
-; (laitem-propagates prev) to include the corresponding laitem in the new state.  Do this anyway
-; for internal lookaheads, regardless of mode.
-;
-; If mode is :canonical-lr-1, kernel-item-alist is a list of pairs (item . lookaheads), where
-; lookaheads is a terminalset of lookaheads for that item.  Use these lookaheads instead of
-; initial-lookaheads.
-(defun make-state (grammar kernel kernel-item-alist mode number initial-lookaheads)
-  (let ((laitems nil)
-        (laitems-hash (make-hash-table :test #'eq))
-        (laitems-maybe-forbidden nil)) ;Association list of:  laitem -> terminalset of potentially forbidden terminals; missing means *empty-terminalset*
-    (labels
-      ;Create a laitem for this item and add the association item->laitem to the laitems-hash
-      ;hash table if it's not there already.  Regardless of whether a new laitem was created,
-      ;update the laitem's lookaheads to also include the given lookaheads.
-      ;forbidden is a terminalset of terminals that must not occur immediately after the dot in this
-      ;laitem.  The forbidden set is inherited from constraints in parent laitems in the same state.
-      ;maybe-forbidden is an upper bounds on the forbidden lookaheads in this laitem.
-      ;If prev is non-null, update (laitem-propagates prev) to include the laitem and the given
-      ;passthrough terminalset if it's not already included there.
-      ;If a new laitem was created and its first symbol after the dot exists and is a
-      ;nonterminal A, recursively close items A->.rhs corresponding to all rhs's in the
-      ;grammar's rule for A.
-      ((close-item (item forbidden maybe-forbidden lookaheads prev passthroughs)
-         (let ((production (item-production item))
-               (dot (item-dot item))
-               (laitem (gethash item laitems-hash)))
-           (let ((extra-forbidden (terminalset-complement (general-production-constraint production dot))))
-             (terminalset-union-f forbidden extra-forbidden)
-             (terminalset-union-f maybe-forbidden extra-forbidden))
-           (unless (terminalset-empty? forbidden)
-             (multiple-value-bind (dot-lookaheads dot-passthroughs)
-                                  (string-initial-terminals grammar (item-unseen item) (production-constraints production) (item-dot item) t)
-               (let ((dot-initial (terminalset-union dot-lookaheads dot-passthroughs)))
-                 ;Check whether any terminal can start this item.  If not, skip this item altogether.
-                 (when (terminalset-empty? (terminalset-difference dot-initial forbidden))
-                   ;Mark skipped items in the laitems-hash table.
-                   (when (and laitem (not (eq laitem 'forbidden)))
-                     (error "Two laitems in the same state differing only in forbidden initial terminal constraints: ~S" laitem))
-                   (setf (gethash item laitems-hash) 'forbidden)
-                   (return-from close-item))
-                 ;Convert forbidden into a canonical format by removing terminals that cannot begin this item's expansion anyway.
-                 (terminalset-intersection-f forbidden dot-initial))))
-           (if laitem
-             (let ((laitem-maybe-forbidden-entry (assoc laitem laitems-maybe-forbidden))
-                   (new-forbidden (terminalset-union forbidden (laitem-forbidden laitem))))
-               (when laitem-maybe-forbidden-entry
-                 (terminalset-intersection-f (cdr laitem-maybe-forbidden-entry) maybe-forbidden))
-               (unless (terminalset-<= new-forbidden (or (cdr laitem-maybe-forbidden-entry) *empty-terminalset*))
-                 (error "Two laitems in the same state differing only in forbidden initial terminal constraints: ~S ~%old forbidden: ~S ~%new forbidden: ~S~%maybe forbidden: ~S"
-                        laitem
-                        (terminalset-list grammar (laitem-forbidden laitem))
-                        (terminalset-list grammar forbidden)
-                        (and laitem-maybe-forbidden-entry (terminalset-list grammar (cdr laitem-maybe-forbidden-entry)))))
-               (setf (laitem-forbidden laitem) new-forbidden)
-               (terminalset-union-f (laitem-lookaheads laitem) lookaheads))
-             (let ((item-next-symbol (item-next-symbol item)))
-               (setq laitem (allocate-laitem grammar item forbidden lookaheads))
-               (push laitem laitems)
-               (setf (gethash item laitems-hash) laitem)
-               (unless (terminalset-empty? maybe-forbidden)
-                 (push (cons laitem maybe-forbidden) laitems-maybe-forbidden))
-               (when (nonterminal? item-next-symbol)
-                 (multiple-value-bind (next-lookaheads next-passthroughs)
-                                      (string-initial-terminals grammar (rest (item-unseen item)) (production-constraints production) (1+ dot) nil)
-                   (let ((next-prev (and (not (terminalset-empty? next-passthroughs)) laitem)))
-                     (dolist (production (rule-productions (grammar-rule grammar item-next-symbol)))
-                       (close-item (make-item grammar production 0) forbidden maybe-forbidden next-lookaheads next-prev next-passthroughs)))))))
-           (when prev
-             (laitem-add-propagation prev laitem passthroughs)))))
-      
-      (dolist (acons kernel-item-alist)
-        (close-item (car acons) 
-                    *empty-terminalset*
-                    *empty-terminalset*
-                    (if (eq mode :canonical-lr-1) (cdr acons) initial-lookaheads)
-                    (and (eq mode :lalr-1) (cdr acons))
-                    *full-terminalset*))
-      (allocate-state number kernel (nreverse laitems)))))
-
-
-; f is a function that takes three arguments:
-;   a grammar symbol;
-;   a list of kernel items in order of increasing item number [list of (item . lookahead) when mode is :canonical-lr-1];
-;   a list of pairs (item . prev), where item is a kernel item and prev is a laitem.
-; For each possible symbol X that can be shifted while in the given state S, call
-; f giving it S and the list of items that constitute the kernel of that shift's destination
-; state.  The prev's are the sources of the corresponding shifted items.
-(defun state-each-shift-item-alist (f state mode)
-  (let ((shift-symbols-hash (make-hash-table :test *grammar-symbol-=*)))
-    (dolist (source-laitem (state-laitems state))
-      (let* ((source-item (laitem-item source-laitem))
-             (shift-symbol (item-next-symbol source-item)))
-        (when shift-symbol
-          (push (cons (item-next source-item) source-laitem)
-                (gethash shift-symbol shift-symbols-hash)))))
-    ;Use dolist/gethash instead of maphash to make state assignments deterministic.
-    (dolist (shift-symbol (sorted-hash-table-keys shift-symbols-hash))
-      (let* ((kernel-item-alist (gethash shift-symbol shift-symbols-hash))
-             (kernel (if (eq mode :canonical-lr-1)
-                       (sort (mapcar #'(lambda (acons)
-                                         (cons (car acons) (laitem-lookaheads (cdr acons))))
-                                     kernel-item-alist)
-                             #'<
-                             :key #'(lambda (acons) (item-number (car acons))))
-                       (sort (mapcar #'car kernel-item-alist) #'< :key #'item-number))))
-        (funcall f shift-symbol kernel kernel-item-alist)))))
-
-
-; f is a function that takes a terminal variant as an argument.
-; For each variant of the given terminal (which, along with kernel-item-alist, was obtained from
-; state-each-shift-item-alist's callback), determine whether that variant can actually occur at the
-; current position or whether it is forbidden by constraints.  If it can occur, call f with that variant.
-; Signal an error if some laitems in kernel-item-alist indicate that a variant can occur while others
-; indicate that the same variant cannot occur.  Also signal an internal error if no variant can occur, as
-; make-state should have filtered such shift items out.
-(defun each-shift-symbol-variant (f grammar terminal kernel-item-alist)
-  (let ((n-applicable-variants 0))
-    (dolist (variant (terminal-variants grammar terminal))
-      (let ((allowed nil)
-            (forbidden nil))
-        (dolist (acons kernel-item-alist)
-          (if (terminal-in-terminalset grammar variant (laitem-forbidden (cdr acons)))
-            (setq forbidden t)
-            (setq allowed t)))
-        (when (eq allowed forbidden)
-          (error "Symbol ~S ~A" variant
-                 (if allowed "both allowed and forbidden" "neither allowed nor forbidden")))
-        (unless forbidden
-          (incf n-applicable-variants)
-          (funcall f variant))))
-    (when (zerop n-applicable-variants)
-      (error "Internal parser error"))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; CANONICAL LR(1)
-;;;
-;;; Canonical LR(1) is accepts the same set of languages as LR(1) except that it produces vastly larger,
-;;; unoptimizied state tables.  The only advantage to using Canonical LR(1) instead of LR(1) is that
-;;; a Canonical LR(1) parser will not make any reductions from an error state, whereas a LR(1) or LALR(1)
-;;; parser might make reductions (but not shifts).  In other words, a Canonical LR(1) parser's shift and
-;;; reduce tables are fully accurate rather than conservative approximations based on merged states.
-
-
-; Make all states in the grammar and return the initial state.
-; Initialize the grammar's list of states.
-; Initialize the states' gotos lists.
-; Initialize the states' shift (but not reduce or accept) transitions in the transitions lists.
-(defun add-all-canonical-lr-states (grammar)
-  (let* ((initial-item (make-item grammar (grammar-start-production grammar) 0))
-         (lr-states-hash (make-hash-table :test #'equal))  ;canonical kernel -> state
-         (initial-kernel (list (cons initial-item (make-terminalset grammar *end-marker*))))
-         (initial-state (make-state grammar initial-kernel initial-kernel :canonical-lr-1 0 nil))
-         (states (list initial-state))
-         (next-state-number 1))
-    (setf (gethash initial-kernel lr-states-hash) initial-state)
-    (do ((source-states (list initial-state)))
-        ((endp source-states))
-      (let ((source-state (pop source-states)))
-        ;Propagate the source state's internal lookaheads and then erase the propagates chains.
-        (propagate-internal-lookaheads source-state)
-        (dolist (laitem (state-laitems source-state))
-          (setf (laitem-propagates laitem) nil))
-        
-        (state-each-shift-item-alist
-         #'(lambda (shift-symbol kernel kernel-item-alist)
-             (let ((destination-state (gethash kernel lr-states-hash)))
-               (unless destination-state
-                 (setq destination-state (make-state grammar kernel kernel :canonical-lr-1 next-state-number nil))
-                 (setf (gethash kernel lr-states-hash) destination-state)
-                 (incf next-state-number)
-                 (push destination-state states)
-                 (push destination-state source-states))
-               (if (nonterminal? shift-symbol)
-                 (push (cons shift-symbol destination-state)
-                       (state-gotos source-state))
-                 (each-shift-symbol-variant
-                  #'(lambda (shift-symbol-variant)
-                      (push (cons shift-symbol-variant (make-shift-transition destination-state))
-                            (state-transitions source-state)))
-                  grammar shift-symbol kernel-item-alist))))
-         source-state :canonical-lr-1)))
-    (setf (grammar-states grammar) (nreverse states))
-    initial-state))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; LR(1)
-
-
-; kernel-item-alist should have the same kernel items as state.
-; Return true if the prev lookaheads in kernel-item-alist are the same as or subsets of
-; the corresponding lookaheads in the state's kernel laitems.
-(defun state-subsumes-lookaheads (state kernel-item-alist)
-  (every
-   #'(lambda (acons)
-       (terminalset-<= (laitem-lookaheads (cdr acons))
-                       (laitem-lookaheads (state-laitem state (car acons)))))
-   kernel-item-alist))
-
-
-; kernel-item-alist should have the same kernel items as state.
-; Return true if the prev lookaheads in kernel-item-alist are weakly compatible
-; with the lookaheads in the state's kernel laitems.
-(defun state-weakly-compatible (state kernel-item-alist)
-  (labels
-    ((lookahead-weakly-compatible (lookahead1a lookahead1b lookahead2a lookahead2b)
-       (or (and (terminalsets-disjoint lookahead1a lookahead2b)
-                (terminalsets-disjoint lookahead1b lookahead2a))
-           (not (terminalsets-disjoint lookahead1a lookahead1b))
-           (not (terminalsets-disjoint lookahead2a lookahead2b))))
-     
-     (lookahead-list-weakly-compatible (lookahead1a lookaheads1 lookahead2a lookaheads2)
-       (or (endp lookaheads1)
-           (and (lookahead-weakly-compatible lookahead1a (first lookaheads1) lookahead2a (first lookaheads2))
-                (lookahead-list-weakly-compatible lookahead1a (rest lookaheads1) lookahead2a (rest lookaheads2)))))
-     
-     (lookahead-lists-weakly-compatible (lookaheads1 lookaheads2)
-       (or (endp lookaheads1)
-           (and (lookahead-list-weakly-compatible (first lookaheads1) (rest lookaheads1) (first lookaheads2) (rest lookaheads2))
-                (lookahead-lists-weakly-compatible (rest lookaheads1) (rest lookaheads2))))))
-    
-    (or (= (length kernel-item-alist) 1)
-        (lookahead-lists-weakly-compatible
-         (mapcar #'(lambda (acons) (laitem-lookaheads (state-laitem state (car acons)))) kernel-item-alist)
-         (mapcar #'(lambda (acons) (laitem-lookaheads (cdr acons))) kernel-item-alist)))))
-
-
-; Propagate all lookaheads in the state.
-(defun propagate-internal-lookaheads (state)
-  (do ((changed t))
-      ((not changed))
-    (setq changed nil)
-    (dolist (src-laitem (state-laitems state))
-      (let ((src-lookaheads (laitem-lookaheads src-laitem)))
-        (dolist (propagation (laitem-propagates src-laitem))
-          (let* ((dst-laitem (car propagation))
-                 (mask (cdr propagation))
-                 (old-dst-lookaheads (laitem-lookaheads dst-laitem))
-                 (new-dst-lookaheads (terminalset-union old-dst-lookaheads (terminalset-intersection src-lookaheads mask))))
-            (setf (laitem-lookaheads dst-laitem) new-dst-lookaheads)
-            (unless (terminalset-= old-dst-lookaheads new-dst-lookaheads)
-              (setq changed t))))))))
-
-
-; Propagate all lookaheads in kernel-item-alist, which must target destination-state.
-; Mark destination-state as dirty in the dirty-states hash table.
-(defun propagate-external-lookaheads (kernel-item-alist destination-state dirty-states)
-  (dolist (acons kernel-item-alist)
-    (let ((dest-laitem (state-laitem destination-state (car acons)))
-          (src-laitem (cdr acons)))
-      (terminalset-union-f (laitem-lookaheads dest-laitem) (laitem-lookaheads src-laitem))))
-  (setf (gethash destination-state dirty-states) t))
-
-
-; Make all states in the grammar and return the initial state.
-; Initialize the grammar's list of states.
-; Initialize the states' gotos lists.
-; Initialize the states' shift (but not reduce or accept) transitions in the transitions lists.
-(defun add-all-lr-states (grammar)
-  (let* ((initial-item (make-item grammar (grammar-start-production grammar) 0))
-         (lr-states-hash (make-hash-table :test #'equal))  ;kernel -> list of states with that kernel
-         (initial-kernel (list initial-item))
-         (initial-state (make-state grammar initial-kernel (list (cons initial-item nil)) :lr-1 0 (make-terminalset grammar *end-marker*)))
-         (states (list initial-state))
-         (next-state-number 1))
-    (setf (gethash initial-kernel lr-states-hash) (list initial-state))
-    (do ((source-states (list initial-state))
-         (dirty-states (make-hash-table :test #'eq)))      ;Set of states whose kernel lookaheads changed and haven't been propagated yet
-        ((and (endp source-states) (zerop (hash-table-count dirty-states))))
-      (labels
-        ((make-destination-state (kernel kernel-item-alist)
-           (let* ((possible-destination-states (gethash kernel lr-states-hash))
-                  (destination-state (find-if #'(lambda (possible-destination-state)
-                                                  (state-subsumes-lookaheads possible-destination-state kernel-item-alist))
-                                              possible-destination-states)))
-             (cond
-              (destination-state)
-              ((setq destination-state (find-if #'(lambda (possible-destination-state)
-                                                    (state-weakly-compatible possible-destination-state kernel-item-alist))
-                                                possible-destination-states))
-               (propagate-external-lookaheads kernel-item-alist destination-state dirty-states))
-              (t
-               (setq destination-state (make-state grammar kernel kernel-item-alist :lr-1 next-state-number *empty-terminalset*))
-               (propagate-external-lookaheads kernel-item-alist destination-state dirty-states)
-               (push destination-state (gethash kernel lr-states-hash))
-               (incf next-state-number)
-               (push destination-state states)
-               (push destination-state source-states)))
-             destination-state))
-         
-         (update-destination-state (destination-state kernel-item-alist)
-           (cond
-            ((state-subsumes-lookaheads destination-state kernel-item-alist)
-             destination-state)
-            ((state-weakly-compatible destination-state kernel-item-alist)
-             (propagate-external-lookaheads kernel-item-alist destination-state dirty-states)
-             destination-state)
-            (t (make-destination-state (state-kernel destination-state) kernel-item-alist)))))
-        
-        (if source-states
-          (let ((source-state (pop source-states)))
-            (remhash source-state dirty-states)
-            (propagate-internal-lookaheads source-state)
-            (state-each-shift-item-alist
-             #'(lambda (shift-symbol kernel kernel-item-alist)
-                 (let ((destination-state (make-destination-state kernel kernel-item-alist)))
-                   (if (nonterminal? shift-symbol)
-                     (push (cons shift-symbol destination-state)
-                           (state-gotos source-state))
-                     (each-shift-symbol-variant
-                      #'(lambda (shift-symbol-variant)
-                          (push (cons shift-symbol-variant (make-shift-transition destination-state))
-                                (state-transitions source-state)))
-                      grammar shift-symbol kernel-item-alist))))
-             source-state :lr-1))
-          (dolist (dirty-state (sort (hash-table-keys dirty-states) #'< :key #'state-number))
-            (when (remhash dirty-state dirty-states)
-              (propagate-internal-lookaheads dirty-state)
-              (state-each-shift-item-alist
-               #'(lambda (shift-symbol kernel kernel-item-alist)
-                   (declare (ignore kernel))
-                   (if (nonterminal? shift-symbol)
-                     (let* ((destination-binding (assoc shift-symbol (state-gotos dirty-state) :test *grammar-symbol-=*))
-                            (destination-state (assert-non-null (cdr destination-binding))))
-                       (setf (cdr destination-binding) (update-destination-state destination-state kernel-item-alist)))
-                     (each-shift-symbol-variant
-                      #'(lambda (shift-symbol-variant)
-                          (let* ((destination-transition (state-transition dirty-state shift-symbol-variant))
-                                 (destination-state (assert-non-null (transition-state destination-transition))))
-                            (setf (transition-state destination-transition)
-                                  (update-destination-state destination-state kernel-item-alist))))
-                      grammar shift-symbol kernel-item-alist)))
-               dirty-state :lr-1))))))
-    (setf (grammar-states grammar) (nreverse states))
-    initial-state))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; LALR(1)
-
-
-; Make all states in the grammar and return the initial state.
-; Initialize the grammar's list of states.
-; Set up the laitems' propagate lists but do not propagate lookaheads yet.
-; Initialize the states' gotos lists.
-; Initialize the states' shift (but not reduce or accept) transitions in the transitions lists.
-(defun add-all-lalr-states (grammar)
-  (let* ((initial-item (make-item grammar (grammar-start-production grammar) 0))
-         (lalr-states-hash (make-hash-table :test #'equal))  ;kernel -> state
-         (initial-kernel (list initial-item))
-         (initial-state (make-state grammar initial-kernel (list (cons initial-item nil)) :lalr-1 0 (make-terminalset grammar *end-marker*)))
-         (states (list initial-state))
-         (next-state-number 1))
-    (setf (gethash initial-kernel lalr-states-hash) initial-state)
-    (do ((source-states (list initial-state)))
-        ((endp source-states))
-      (let ((source-state (pop source-states)))
-        (state-each-shift-item-alist
-         #'(lambda (shift-symbol kernel kernel-item-alist)
-             (let ((destination-state (gethash kernel lalr-states-hash)))
-               (if destination-state
-                 (dolist (acons kernel-item-alist)
-                   (laitem-add-propagation (cdr acons) (state-laitem destination-state (car acons)) *full-terminalset*))
-                 (progn
-                   (setq destination-state (make-state grammar kernel kernel-item-alist :lalr-1 next-state-number *empty-terminalset*))
-                   (setf (gethash kernel lalr-states-hash) destination-state)
-                   (incf next-state-number)
-                   (push destination-state states)
-                   (push destination-state source-states)))
-               (if (nonterminal? shift-symbol)
-                 (push (cons shift-symbol destination-state)
-                       (state-gotos source-state))
-                 (each-shift-symbol-variant
-                  #'(lambda (shift-symbol-variant)
-                      (push (cons shift-symbol-variant (make-shift-transition destination-state))
-                            (state-transitions source-state)))
-                  grammar shift-symbol kernel-item-alist))))
-         source-state :lalr-1)))
-    (setf (grammar-states grammar) (nreverse states))
-    initial-state))
-
-
-; Propagate the lookaheads in the LALR(1) grammar.
-(defun propagate-lalr-lookaheads (grammar)
-  (let ((dirty-laitems (make-hash-table :test #'eq)))
-    (dolist (state (grammar-states grammar))
-      (dolist (laitem (state-laitems state))
-        (when (and (laitem-propagates laitem) (not (terminalset-empty? (laitem-lookaheads laitem))))
-          (setf (gethash laitem dirty-laitems) t))))
-    (do ()
-        ((zerop (hash-table-count dirty-laitems)))
-      (dolist (dirty-laitem (hash-table-keys dirty-laitems))
-        (remhash dirty-laitem dirty-laitems)
-        (let ((src-lookaheads (laitem-lookaheads dirty-laitem)))
-          (dolist (propagation (laitem-propagates dirty-laitem))
-            (let ((dst-laitem (car propagation))
-                  (mask (cdr propagation)))
-              (let* ((old-dst-lookaheads (laitem-lookaheads dst-laitem))
-                     (new-dst-lookaheads (terminalset-union old-dst-lookaheads (terminalset-intersection src-lookaheads mask))))
-                (unless (terminalset-= old-dst-lookaheads new-dst-lookaheads)
-                  (setf (laitem-lookaheads dst-laitem) new-dst-lookaheads)
-                  (setf (gethash dst-laitem dirty-laitems) t))))))))
-    
-    ;Erase the propagates chains in all laitems.
-    (dolist (state (grammar-states grammar))
-      (dolist (laitem (state-laitems state))
-        (setf (laitem-propagates laitem) nil)))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-
-
-; Calculate the reduce and accept transitions in the grammar.
-; Also sort all transitions by their terminal numbers and gotos by their nonterminal numbers.
-; Conflicting transitions are sorted as follows:
-;    shifts come before reduces and accepts
-;    accepts come before reduces
-;    reduces with lower production numbers come before reduces with higher production numbers
-; Disambiguation will choose the first member of a sorted list of conflicting transitions.
-(defun finish-transitions (grammar)
-  (dolist (state (grammar-states grammar))
-    (dolist (laitem (state-laitems state))
-      (let ((item (laitem-item laitem)))
-        (unless (item-next-symbol item)
-          (let ((lookaheads (terminalset-difference
-                             (terminalset-intersection
-                              (laitem-lookaheads laitem)
-                              (general-production-constraint (item-production item) (item-dot item)))
-                             (laitem-forbidden laitem))))
-            (if (grammar-symbol-= (item-lhs item) *start-nonterminal*)
-              (when (terminal-in-terminalset grammar *end-marker* lookaheads)
-                (push (cons *end-marker* (make-accept-transition))
-                      (state-transitions state)))
-              (map-terminalset-reverse
-               #'(lambda (lookahead)
-                   (push (cons lookahead (make-reduce-transition (item-production item)))
-                         (state-transitions state)))
-               grammar
-               lookaheads))))))
-    (setf (state-gotos state)
-          (sort (state-gotos state) #'< :key #'(lambda (goto-cons) (state-number (cdr goto-cons)))))
-    (setf (state-transitions state)
-          (sort (state-transitions state)
-                #'(lambda (transition-cons-1 transition-cons-2)
-                    (let ((terminal-number-1 (terminal-number grammar (car transition-cons-1)))
-                          (terminal-number-2 (terminal-number grammar (car transition-cons-2))))
-                      (cond
-                       ((< terminal-number-1 terminal-number-2) t)
-                       ((> terminal-number-1 terminal-number-2) nil)
-                       (t (let* ((transition1 (cdr transition-cons-1))
-                                 (transition2 (cdr transition-cons-2))
-                                 (transition-kind-1 (transition-kind transition1))
-                                 (transition-kind-2 (transition-kind transition2)))
-                            (cond
-                             ((eq transition-kind-2 :shift) nil)
-                             ((eq transition-kind-1 :shift) t)
-                             ((eq transition-kind-2 :accept) nil)
-                             ((eq transition-kind-1 :accept) t)
-                             (t (let ((production-number-1 (production-number (transition-production transition1)))
-                                      (production-number-2 (production-number (transition-production transition2))))
-                                  (< production-number-1 production-number-2)))))))))))))
-
-
-; Find ambiguities, if any, in the grammar.  Report them on the given stream.
-; Fix all ambiguities in favor of the first transition listed
-; (the transitions were ordered by finish-transitions).
-; Return true if ambiguities were found.
-(defun report-and-fix-ambiguities (grammar stream)
-  (let ((found-ambiguities nil))
-    (dolist (state (grammar-states grammar))
-      (labels
-        
-        ((report-ambiguity (transition-cons other-transition-conses)
-           (unless found-ambiguities
-             (setq found-ambiguities t)
-             (format stream "~&Ambiguities:"))
-           (write-char #\newline stream)
-           (pprint-logical-block (stream nil)
-             (format stream "S~D: ~W => " (state-number state) (car transition-cons))
-             (pprint-logical-block (stream nil)
-               (dolist (a (cons transition-cons other-transition-conses))
-                 (print-transition (cdr a) stream)
-                 (format stream "   ~:_")))))
-         
-         ; Check the list of transition-conses and report ambiguities.
-         ; start is the start of a possibly larger list of transition-conses whose tail
-         ; is the given list.  If ambiguities exist, return a copy of start up to the
-         ; position of list in it followed by list with ambiguities removed.  If not,
-         ; return start unchanged.
-         (check (transition-conses start)
-           (if transition-conses
-             (let* ((transition-cons (first transition-conses))
-                    (transition-terminal (car transition-cons))
-                    (transition-conses-rest (rest transition-conses)))
-               (if transition-conses-rest
-                 (if (grammar-symbol-= transition-terminal (car (first transition-conses-rest)))
-                   (let ((unrelated-transitions
-                          (member-if #'(lambda (a) (not (grammar-symbol-= transition-terminal (car a))))
-                                     transition-conses-rest)))
-                     (report-ambiguity transition-cons (ldiff transition-conses-rest unrelated-transitions))
-                     (check unrelated-transitions (append (ldiff start transition-conses-rest) unrelated-transitions)))
-                   (check transition-conses-rest start))
-                 start))
-             start)))
-        
-        (let ((transition-conses (state-transitions state)))
-          (setf (state-transitions state) (check transition-conses transition-conses)))))
-    (when found-ambiguities
-      (write-char #\newline stream))
-    found-ambiguities))
-
-
-; Remove the temporary item and laitem lists from the grammar's states.  This reduces the grammar's lisp
-; heap usage but prevents it from being printed.
-(defun clean-grammar (grammar)
-  (when (grammar-items-hash grammar)
-    (setf (grammar-items-hash grammar) nil)
-    (dolist (state (grammar-states grammar))
-      (setf (state-kernel state) nil)
-      (setf (state-laitems state) nil))))
-
-
-; Erase the existing parser, if any, for the given grammar.
-(defun clear-parser (grammar)
-  (setf (grammar-items-hash grammar) nil)
-  (setf (grammar-states grammar) nil))
-
-
-; Construct a LR or LALR parser in the given grammar.  kind should be :lalr-1, :lr-1, or :canonical-lr-1.
-; Return true if ambiguities were found.
-(defun compile-parser (grammar kind)
-  (clear-parser grammar)
-  (setf (grammar-items-hash grammar) (make-hash-table :test #'equal))
-  (ecase kind
-    (:lalr-1
-     (add-all-lalr-states grammar)
-     (propagate-lalr-lookaheads grammar))
-    (:lr-1
-     (add-all-lr-states grammar))
-    (:canonical-lr-1
-     (add-all-canonical-lr-states grammar)))
-  (finish-transitions grammar)
-  (report-and-fix-ambiguities grammar *error-output*))
-
-
-
-; (cons (list <kind> <start-symbol> <grammar-source> <grammar-options>) <grammar>)
-(defvar *make-and-compile-grammar-cache* (cons nil nil))
-
-; Make the grammar and compile its parser.  kind should be :lalr-1, :lr-1, or :canonical-lr-1.
-(defun make-and-compile-grammar (kind parametrization start-symbol grammar-source &rest grammar-options)
-  (let ((key (list kind start-symbol grammar-source grammar-options))
-        (cached-grammar (cdr *make-and-compile-grammar-cache*)))
-    (if (and (equal key (car *make-and-compile-grammar-cache*))
-             (grammar-parametrization-= parametrization cached-grammar))
-      (progn
-        (format *trace-output* "Re-using grammar ~S ~S ~S~%" kind start-symbol grammar-options)
-        cached-grammar)
-      (let* ((grammar (apply #'make-grammar parametrization start-symbol grammar-source grammar-options))
-             (found-ambiguities (compile-parser grammar kind)))
-        (setq *make-and-compile-grammar-cache*
-              (if found-ambiguities
-                (cons nil nil)
-                (cons key grammar)))
-        grammar))))
-
-
-; Collapse states that have at most one possible reduction into forwarding states.
-; DON'T DO THIS ON GRAMMARS THAT HAVE CONSTRAINTS AT THE TAIL END OF A PRODUCTION.
-; Return the number of states optimized.
-(defun forward-parser-states (grammar)
-  (let ((n-forwarded-states 0))
-    (dolist (state (grammar-states grammar))
-      (let ((production (forwarding-state-production state)))
-        (when production
-          (setf (state-transitions state) (list (cons nil (make-reduce-transition production))))
-          (incf n-forwarded-states))))
-    n-forwarded-states))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-
-; Parse the input list of tokens to produce a parse tree.
-; token-terminal is a function that returns a terminal symbol when given an input token.
-(defun parse (grammar token-terminal input)
-  (labels
-    (;Continue the parse with the given parser stack and remainder of input.
-     (parse-step (stack input)
-       (if (endp input)
-         (parse-step-1 stack *end-marker* nil nil)
-         (let ((token (first input)))
-           (parse-step-1 stack (funcall token-terminal token) token (rest input)))))
-     
-     ;Same as parse-step except that the next input terminal has been determined already.
-     ;input-rest contains the input tokens after the next token.
-     (parse-step-1 (stack terminal token input-rest)
-       (let* ((state (caar stack))
-              (transition (state-transition state terminal)))
-         (if transition
-           (case (transition-kind transition)
-             (:shift (parse-step (acons (transition-state transition) token stack) input-rest))
-             (:reduce (let ((production (transition-production transition))
-                            (expansion nil))
-                        (dotimes (i (production-rhs-length production))
-                          (push (cdr (pop stack)) expansion))
-                        (let* ((state (caar stack))
-                               (dst-state (assert-non-null
-                                           (cdr (assoc (production-lhs production) (state-gotos state) :test *grammar-symbol-=*))))
-                               (named-expansion (cons (production-name production) expansion)))
-                          (parse-step-1 (acons dst-state named-expansion stack) terminal token input-rest))))
-             (:accept (cdar stack))
-             (t (error "Bad transition: ~S" transition)))
-           (error "Parse error on ~S followed by ~S ..." token (ldiff input-rest (nthcdr 10 input-rest)))))))
-    
-    (parse-step (list (cons (grammar-start-state grammar) nil)) input)))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; ACTIONS
-
-; Initialize the action-signatures hash table, setting each grammar symbol's signature
-; to null for now.  Also clear all production actions in the grammar.
-(defun clear-actions (grammar)
-  (let ((action-signatures (make-hash-table :test *grammar-symbol-=*))
-        (terminals (grammar-terminals grammar))
-        (nonterminals (grammar-nonterminals grammar)))
-    (dotimes (i (length terminals))
-      (setf (gethash (svref terminals i) action-signatures) nil))
-    (dotimes (i (length nonterminals))
-      (setf (gethash (svref nonterminals i) action-signatures) nil))
-    (setf (grammar-action-signatures grammar) action-signatures)
-    (each-grammar-production
-     grammar
-     #'(lambda (production)
-         (setf (production-actions production) nil)
-         (setf (production-n-action-args production) nil)
-         (setf (production-evaluator-code production) nil)
-         (setf (production-evaluator production) nil)))
-    (clrhash (grammar-terminal-actions grammar))))
-
-
-; Declare the type of action action-symbol, when called on general-grammar-symbol, to be type-expr.
-; Signal an error on duplicate actions.
-; It's OK if some of the symbol instances don't exist, as long as at least one does.
-(defun declare-action (grammar general-grammar-symbol action-symbol type-expr)
-  (unless (and action-symbol (symbolp action-symbol))
-    (error "Bad action name ~S" action-symbol))
-  (let ((action-signatures (grammar-action-signatures grammar))
-        (grammar-symbols (general-grammar-symbol-instances grammar general-grammar-symbol))
-        (symbol-exists nil))
-    (dolist (grammar-symbol grammar-symbols)
-      (let ((signature (gethash grammar-symbol action-signatures :undefined)))
-        (unless (eq signature :undefined)
-          (setq symbol-exists t)
-          (when (assoc action-symbol signature :test #'eq)
-            (error "Attempt to redefine the type of action ~S on ~S" action-symbol grammar-symbol))
-          (setf (gethash grammar-symbol action-signatures)
-                (nconc signature (list (cons action-symbol type-expr))))
-          (if (nonterminal? grammar-symbol)
-            (dolist (production (rule-productions (grammar-rule grammar grammar-symbol)))
-              (setf (production-actions production)
-                    (nconc (production-actions production) (list (cons action-symbol nil)))))
-            (let ((terminal-actions (grammar-terminal-actions grammar)))
-              (assert-type grammar-symbol terminal)
-              (setf (gethash grammar-symbol terminal-actions)
-                    (nconc (gethash grammar-symbol terminal-actions) (list (cons action-symbol nil)))))))))
-    (unless symbol-exists
-      (error "Bad action grammar symbol ~S" grammar-symbols))))
-
-
-; Return the list of pairs (action-symbol . type-or-type-expr) for this grammar-symbol.
-; The pairs are in order from oldest to newest action-symbols added to this grammar-symbol.
-(declaim (inline grammar-symbol-signature))
-(defun grammar-symbol-signature (grammar grammar-symbol)
-  (gethash grammar-symbol (grammar-action-signatures grammar)))
-
-
-; Return the list of action types of the grammar's user start-symbol.
-(defun grammar-user-start-action-types (grammar)
-  (mapcar #'cdr (grammar-symbol-signature grammar (gramar-user-start-symbol grammar))))
-
-
-; If action action-symbol is declared on grammar-symbol, return two values:
-;   t, and
-;   the action's type-expr;
-; If not, return nil.
-(defun action-declaration (grammar grammar-symbol action-symbol)
-  (let ((declaration (assoc action-symbol (grammar-symbol-signature grammar grammar-symbol) :test #'eq)))
-    (and declaration
-         (values t (cdr declaration)))))
-
-
-; Call f on every action declaration, passing it two arguments:
-;   the grammar-symbol;
-;   a pair (action-symbol . type-expr).
-; f may modify the action's type-expr.
-(defun each-action-declaration (grammar f)
-  (maphash #'(lambda (grammar-symbol signature)
-               (dolist (action-declaration signature)
-                 (funcall f grammar-symbol action-declaration)))
-           (grammar-action-signatures grammar)))
-
-
-; Define action action-symbol, when called on the production with the given name,
-; to be action-expr.  The action should have been declared already.
-(defun define-action (grammar production-name action-symbol action-expr)
-  (dolist (production (general-production-productions (grammar-general-production grammar production-name)))
-    (let ((definition (assoc action-symbol (production-actions production) :test #'eq)))
-      (cond
-       ((null definition)
-        (error "Attempt to define action ~S on ~S, which hasn't been declared yet" action-symbol production-name))
-       ((cdr definition)
-        (error "Duplicate definition of action ~S on ~S" action-symbol production-name))
-       (t (setf (cdr definition) (make-action action-expr)))))))
-
-
-; Define action action-symbol, when called on the given terminal,
-; to execute the given function, which should take a token as an input and
-; produce a value of the proper type as output.
-; The action should have been declared already.
-(defun define-terminal-action (grammar terminal action-symbol action-function)
-  (assert-type action-function function)
-  (let ((definition (assoc action-symbol (gethash terminal (grammar-terminal-actions grammar)) :test #'eq)))
-    (cond
-     ((null definition)
-      (error "Attempt to define action ~S on ~S, which hasn't been declared yet" action-symbol terminal))
-     ((cdr definition)
-      (error "Duplicate definition of action ~S on ~S" action-symbol terminal))
-     (t (setf (cdr definition) action-function)))))
-
-
-
-; Parse the input list of tokens to produce a list of action results.
-; token-terminal is a function that returns a terminal symbol when given an input token.
-; If trace is:
-;   nil,     don't print trace information
-;   :code,   print trace information, including action code
-;   other    print trace information
-; Return two values:
-;   the list of action results;
-;   the list of action results' types.
-(defun action-parse (grammar token-terminal input &key trace)
-  (labels
-    (;Continue the parse with the given stacks and remainder of input.
-     ;When trace is non-null, type-stack contains the types of corresponding value-stack entries.
-     (parse-step (state-stack value-stack type-stack input)
-       (if (endp input)
-         (parse-step-1 state-stack value-stack type-stack *end-marker* nil nil)
-         (let ((token (first input)))
-           (parse-step-1 state-stack value-stack type-stack (funcall token-terminal token) token (rest input)))))
-     
-     ;Same as parse-step except that the next input terminal has been determined already.
-     ;input-rest contains the input tokens after the next token.
-     (parse-step-1 (state-stack value-stack type-stack terminal token input-rest)
-       (let* ((state (car state-stack))
-              (transition (state-transition state terminal)))
-         (when trace
-           (format *trace-output* "S~D: ~@_" (state-number state))
-           (print-values (reverse value-stack) (reverse type-stack) *trace-output*)
-           (pprint-newline :mandatory *trace-output*))
-         (if transition
-           (case (transition-kind transition)
-             (:shift
-              (when trace
-                (format *trace-output* "  shift ~W~:@_" terminal)
-                (dolist (action-signature (grammar-symbol-signature grammar terminal))
-                  (push (cdr action-signature) type-stack)))
-              (dolist (action-function-binding (gethash terminal (grammar-terminal-actions grammar)))
-                (push (funcall (cdr action-function-binding) token) value-stack))
-              (parse-step (cons (transition-state transition) state-stack) value-stack type-stack input-rest))
-             
-             (:reduce
-              (let ((production (transition-production transition)))
-                (when trace
-                  (write-string "  reduce " *trace-output*)
-                  (if (eq trace :code)
-                    (write production :stream *trace-output* :pretty t)
-                    (print-production production *trace-output*))
-                  (pprint-newline :mandatory *trace-output*))
-                (let* ((state-stack (nthcdr (production-rhs-length production) state-stack))
-                       (state (car state-stack))
-                       (dst-state (assert-non-null
-                                   (cdr (assoc (production-lhs production) (state-gotos state) :test *grammar-symbol-=*))))
-                       (value-stack (funcall (production-evaluator production) value-stack)))
-                  (when trace
-                    (setq type-stack (nthcdr (production-n-action-args production) type-stack))
-                    (dolist (action-signature (grammar-symbol-signature grammar (production-lhs production)))
-                      (push (cdr action-signature) type-stack)))
-                  (parse-step-1 (cons dst-state state-stack) value-stack type-stack terminal token input-rest))))
-             
-             (:accept
-              (when trace
-                (format *trace-output* "  accept~:@_"))
-              (values
-               (nreverse value-stack)
-               (if trace
-                 (nreverse type-stack)
-                 (grammar-user-start-action-types grammar))))
-             
-             (t (error "Bad transition: ~S" transition)))
-           (error "Parse error on ~S followed by ~S ..." token (ldiff input-rest (nthcdr 10 input-rest)))))))
-    
-    (parse-step (list (grammar-start-state grammar)) nil nil input)))
-

mozilla/js2/semantics/README

@@ -1,11 +0,0 @@
-js/semantics contains experimental code used to generate LR(1) and LALR(1)
-grammars for JavaScript as well as compile and check formal semantics for
-JavaScript.  The semantics can be executed directly or printed into either
-HTML or Microsoft Word RTF formats.
-
-This code is written in standard Common Lisp.  It's been used under Macintosh
-Common Lisp 4.0, and Allegro Common Lisp 5.0.1 for Windows, but should also work
-under other Common Lisp implementations.
-
-Contact Waldemar Horwat (waldemar@netscape.com or waldemar@acm.org) for
-more information.

mozilla/js2/semantics/Test/BaseExample.lisp

@@ -1,68 +0,0 @@
-(progn
-  (defparameter *bew*
-    (generate-world
-     "BE"
-     '((lexer base-example-lexer
-              :lalr-1
-              :numeral
-              ((:digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                       ((value $digit-value))))
-              (($digit-value integer digit-value digit-char-36)))
-       
-       (deftype semantic-exception (oneof syntax-error))
-       
-       (%charclass :digit)
-       
-       (rule :digits ((decimal-value integer)
-                      (base-value (-> (integer) integer)))
-         (production :digits (:digit) digits-first
-           (decimal-value (value :digit))
-           ((base-value (base integer))
-            (let ((d integer (value :digit)))
-              (if (< d base) d (throw (oneof syntax-error))))))
-         (production :digits (:digits :digit) digits-rest
-           (decimal-value (+ (* 10 (decimal-value :digits)) (value :digit)))
-           ((base-value (base integer))
-            (let ((d integer (value :digit)))
-              (if (< d base)
-                (+ (* base ((base-value :digits) base)) d)
-                (throw (oneof syntax-error)))))))
-       
-       (rule :numeral ((value integer))
-         (production :numeral (:digits) numeral-digits
-           (value (decimal-value :digits)))
-         (production :numeral (:digits #\# :digits) numeral-digits-and-base
-           (value
-            (let ((base integer (decimal-value :digits 2)))
-              (if (and (>= base 2) (<= base 10))
-                ((base-value :digits 1) base)
-                (throw (oneof syntax-error)))))))
-       (%print-actions)
-       )))
-  
-  (defparameter *bel* (world-lexer *bew* 'base-example-lexer))
-  (defparameter *beg* (lexer-grammar *bel*)))
-
-#|
-(depict-rtf-to-local-file
- "Test/BaseExampleSemantics.rtf"
- "Base Example Semantics"
- #'(lambda (rtf-stream)
-     (depict-world-commands rtf-stream *bew*)))
-
-(depict-html-to-local-file
- "Test/BaseExampleSemantics.html"
- "Base Example Semantics"
- t
- #'(lambda (html-stream)
-     (depict-world-commands html-stream *bew*))
- :external-link-base "")
-
-
-(lexer-pparse *bel* "37")
-(lexer-pparse *bel* "33#4")
-(lexer-pparse *bel* "30#2")
-
-|#
-
-(length (grammar-states *beg*))

mozilla/js2/semantics/Test/CanonicalLRTest.lisp

@@ -1,66 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; Canonical LR(1) test grammar
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-(declaim (optimize (debug 3)))
-
-(progn
-  (defparameter *clrtw*
-    (generate-world
-     "T"
-     '((grammar canonical-lr-test-grammar :canonical-lr-1 :start)
-       
-       (production :start (:expr) start-expr)
-       (production :start (:expr !) start-expr-!)
-       
-       (production :expr (id) expr-id)
-       (production :expr (:expr + id) expr-plus)
-       (production :expr (:expr - id (:- -)) expr-minus)
-       (production :expr (\( :expr \)) expr-parens)
-       )))
-  
-  (defparameter *clrtg* (world-grammar *clrtw* 'canonical-lr-test-grammar)))
-
-
-#|
-(depict-rtf-to-local-file
- "Test/CanonicalLRTestGrammar.rtf"
- "Canonical LR(1) Test Grammar"
- #'(lambda (markup-stream)
-     (depict-world-commands markup-stream *clrtw* :visible-semantics nil)))
-
-(depict-html-to-local-file
- "Test/CanonicalLRTestGrammar.html"
- "Canonical LR(1) Test Grammar"
- t
- #'(lambda (markup-stream)
-     (depict-world-commands markup-stream *clrtw* :visible-semantics nil)))
-
-(print-grammar *clrtg*)
-(with-local-output (s "Test/CanonicalLRTestGrammar.txt") (print-grammar *clrtg* s))
-
-(pprint (parse *clrtg* #'identity '(begin letter letter letter digit end)))
-|#
-
-(length (grammar-states *clrtg*))

mozilla/js2/semantics/Test/ConstraintTest.lisp

@@ -1,71 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; Constraint test grammar
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-(declaim (optimize (debug 3)))
-
-(progn
-  (defparameter *ctw*
-    (generate-world
-     "T"
-     '((grammar constraint-test-grammar :lr-1 :start)
-       
-       (production :start (:string) start-string)
-       (production :start ((:- letter digit) :chars) start-escape)
-       (production :start ((:- escape) :char) start-letter-digit)
-       
-       (production :string (begin :chars end) string)
-       
-       (production :chars () chars-none)
-       (production :chars (:chars :char) chars-some)
-       
-       (production :char (letter (:- letter)) char-letter)
-       (production :char (digit) char-digit)
-       (production :char (escape digit (:- digit)) char-escape-1)
-       (production :char (escape digit digit) char-escape-2)
-       )))
-  
-  (defparameter *ctg* (world-grammar *ctw* 'constraint-test-grammar)))
-
-
-#|
-(depict-rtf-to-local-file
- "Test/ConstraintTestGrammar.rtf"
- "Constraint Test Grammar"
- #'(lambda (markup-stream)
-     (depict-world-commands markup-stream *ctw* :visible-semantics nil)))
-
-(depict-html-to-local-file
- "Test/ConstraintTestGrammar.html"
- "Constraint Test Grammar"
- t
- #'(lambda (markup-stream)
-     (depict-world-commands markup-stream *ctw* :visible-semantics nil)))
-
-(with-local-output (s "Test/ConstraintTestGrammar.txt") (print-grammar *ctg* s))
-
-(pprint (parse *ctg* #'identity '(begin letter letter letter digit end)))
-|#
-
-(length (grammar-states *ctg*))

mozilla/js2/semantics/Test/LineTest.lisp

@@ -1,68 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; Line-break sensitive test grammar
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-(declaim (optimize (debug 3)))
-
-(progn
-  (defparameter *ltw*
-    (generate-world
-     "T"
-     '((line-grammar line-test-grammar :lalr-1 :start)
-       
-       (production :start (a) start-a)
-       (production :start (b :no-line-break c) start-b-c)
-       (production :start (d :no-line-break :y z) start-d-y-z)
-       (production :start (e :y z) start-e-y-z)
-       (production :start (:q :no-line-break a) start-q-a)
-       (production :start (c :q a) start-c-q-a)
-       (production :y () y-empty)
-       (production :y (x) y-x)
-       (production :q (x x) q-x-x)
-       )))
-  
-  (defparameter *ltg* (world-grammar *ltw* 'line-test-grammar)))
-
-
-#|
-(depict-rtf-to-local-file
- "Test/LineTestGrammar.rtf"
- "Line Test Grammar"
- #'(lambda (markup-stream)
-     (depict-world-commands markup-stream *ltw* :visible-semantics nil)))
-
-(depict-html-to-local-file
- "Test/LineTestGrammar.html"
- "Line Test Grammar"
- t
- #'(lambda (markup-stream)
-     (depict-world-commands markup-stream *ltw* :visible-semantics nil)))
-
-(print-grammar *ltg*)
-(with-local-output (s "Test/LineTestGrammar.txt") (print-grammar *ltg* s))
-
-;(pprint (parse *ltg* #'identity '(begin letter letter letter digit end)))
-|#
-
-(length (grammar-states *ltg*))

mozilla/js2/semantics/Test/NameResolution.lisp

@@ -1,71 +0,0 @@
-(progn
-  (defparameter *nw*
-    (generate-world
-     "N"
-     '((grammar name-resolution-grammar :lalr-1 :start)
-       
-       (production :start () start-none)
-       
-       (deftype value (oneof null abstract-value))
-       (deftype class (oneof abstract-class))
-       (deftype type (oneof abstract-type))
-       (deftype namespace (oneof abstract-namespace))
-       (deftype scope (oneof abstract-scope))
-
-       (deftype getter (-> (value) value))
-       (deftype setter (-> (value value) value))
-
-       (%section "Namespaces")
-
-       (define (create-namespace (supernamespaces (vector namespace))) namespace
-         (bottom))
-
-       (%section "Classes and Intefaces")
-
-       (define (create-class (interface boolean) (superclasses (vector class)) (implementees (vector class))) class
-         (bottom))
-
-       (define (create-uninitialized-instance-slot (c class) (t type)) (tuple (get getter) (set setter))
-         (bottom))
-
-       (define (create-instance-slot (c class) (t type) (initial-value value)) (tuple (get getter) (set setter))
-         (bottom))
-
-       (define (freeze-instance-slots (c class)) void
-         (bottom))
-
-       (define (create-instance (c class)) value
-         (bottom))
-
-       (%section "Members")
-
-       (define (add-getter-member (visibility scope) (n namespace) (c class) (name string) (g getter)) void
-         (bottom))
-       (define (add-setter-member (visibility scope) (n namespace) (c class) (name string) (s setter)) void
-         (bottom))
-
-       (define (lookup-getter-member (s scope) (n namespace) (v value) (name string)) getter
-         (bottom))
-       (define (lookup-setter-member (s scope) (n namespace) (v value) (name string)) setter
-         (bottom))
-       )))
-  
-  (defparameter *ng* (world-grammar *nw* 'name-resolution-grammar)))
-
-#|
-(depict-rtf-to-local-file
- "Test/NameResolutionSemantics.rtf"
- "Name Resolution Semantics"
- #'(lambda (rtf-stream)
-     (depict-world-commands rtf-stream *nw*)))
-|#
-
-(depict-html-to-local-file
- "Test/NameResolutionSemantics.html"
- "Name Resolution Semantics"
- t
- #'(lambda (html-stream)
-     (depict-world-commands html-stream *nw*))
- :external-link-base "")
-
-(length (grammar-states *ng*))

mozilla/js2/semantics/Test/StandardFunction.lisp

@@ -1,37 +0,0 @@
-(progn
-  (defparameter *sfw*
-    (generate-world
-     "SF"
-     '((grammar standard-function-grammar :lalr-1 :start)
-       
-       (production :start () start-none)
-       
-       (define (x-digit-value (c character)) integer
-         (if (character-set-member c (set-of-ranges character #\0 #\9))
-           (- (character-to-code c) (character-to-code #\0))
-           (if (character-set-member c (set-of-ranges character #\A #\Z))
-             (+ (- (character-to-code c) (character-to-code #\A)) 10)
-             (if (character-set-member c (set-of-ranges character #\a #\z))
-               (+ (- (character-to-code c) (character-to-code #\a)) 10)
-               (bottom)))))
-       )))
-  
-  (defparameter *sfg* (world-grammar *sfw* 'standard-function-grammar)))
-
-#|
-(depict-rtf-to-local-file
- "Test/StandardFunctionSemantics.rtf"
- "Standard Function Semantics"
- #'(lambda (rtf-stream)
-     (depict-world-commands rtf-stream *sfw*)))
-
-(depict-html-to-local-file
- "Test/StandardFunctionSemantics.html"
- "Standard Function Semantics"
- t
- #'(lambda (html-stream)
-     (depict-world-commands html-stream *sfw*))
- :external-link-base "")
-|#
-
-(length (grammar-states *sfg*))

mozilla/js2/semantics/Test/ThrowCatch.lisp

@@ -1,56 +0,0 @@
-(progn
-  (defparameter *tcw*
-    (generate-world
-     "TC"
-     '((lexer throw-catch-lexer
-              :lalr-1
-              :main
-              ((:digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                       ((value $digit-value))))
-              (($digit-value integer digit-value digit-char-36)))
-       
-       (%charclass :digit)
-       
-       (deftype semantic-exception integer)
-       
-       (rule :expr ((value (-> () integer)))
-         (production :expr (:digit) expr-digit
-           ((value) (value :digit)))
-         (production :expr (#\t :expr) expr-throw
-           ((value) (throw ((value :expr)))))
-         (production :expr (#\c #\{ :expr #\} :expr) expr-catch
-           ((value) (catch ((value :expr 1))
-                    (e) (+ (* e 10) ((value :expr 2)))))))
-       
-       (rule :main ((value integer))
-         (production :main (:expr) main-expr
-           (value ((value :expr)))))
-       (%print-actions)
-       )))
-  
-  (defparameter *tcl* (world-lexer *tcw* 'throw-catch-lexer))
-  (defparameter *tcg* (lexer-grammar *tcl*)))
-
-#|
-(depict-rtf-to-local-file
- "Test/ThrowCatchSemantics.rtf"
- "Base Example Semantics"
- #'(lambda (rtf-stream)
-     (depict-world-commands rtf-stream *tcw*)))
-
-(depict-html-to-local-file
- "Test/ThrowCatchSemantics.html"
- "Base Example Semantics"
- t
- #'(lambda (html-stream)
-     (depict-world-commands html-stream *tcw*))
- :external-link-base "")
-
-
-(lexer-pparse *tcl* "7")
-(lexer-pparse *tcl* "t3")
-(lexer-pparse *tcl* "c{t6}5")
-
-|#
-
-(length (grammar-states *tcg*))

mozilla/js2/semantics/Utilities.lisp

@@ -1,736 +0,0 @@
-;;; The contents of this file are subject to the Mozilla Public
-;;; License Version 1.1 (the "License"); you may not use this file
-;;; except in compliance with the License. You may obtain a copy of
-;;; the License at http://www.mozilla.org/MPL/
-;;; 
-;;; Software distributed under the License is distributed on an "AS
-;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-;;; implied. See the License for the specific language governing
-;;; rights and limitations under the License.
-;;; 
-;;; The Original Code is the Language Design and Prototyping Environment.
-;;; 
-;;; The Initial Developer of the Original Code is Netscape Communications
-;;; Corporation.  Portions created by Netscape Communications Corporation are
-;;; Copyright (C) 1999 Netscape Communications Corporation.  All
-;;; Rights Reserved.
-;;; 
-;;; Contributor(s):   Waldemar Horwat <waldemar@acm.org>
-
-;;;
-;;; Handy lisp utilities
-;;;
-;;; Waldemar Horwat (waldemar@acm.org)
-;;;
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; MCL FIXES
-
-
-(setq *print-right-margin* 150)
-
-;;; Fix name-char and char-name.
-#+mcl
-(locally
-  (declare (optimize (speed 3) (safety 0) (debug 1)))
-  (eval-when (:compile-toplevel :load-toplevel :execute)
-    (setq *warn-if-redefine* nil)
-    (setq *warn-if-redefine-kernel* nil))
-  
-  (defun char-name (c)  
-    (dolist (e ccl::*name-char-alist*)
-      (declare (list e))    
-      (when (eq c (cdr e))
-        (return-from char-name (car e))))
-    (let ((code (char-code c)))
-      (declare (fixnum code))
-      (cond ((< code #x100)
-             (unless (and (>= code 32) (<= code 216) (/= code 127))
-               (format nil "x~2,'0X" code)))
-            (t (format nil "u~4,'0X" code)))))
-  
-  (defun name-char (name)
-    (if (characterp name)
-      name
-      (let* ((name (string name))
-             (namelen (length name)))
-        (declare (fixnum namelen))
-        (or (cdr (assoc name ccl::*name-char-alist* :test #'string-equal))
-            (if (= namelen 1)
-              (char name 0)
-              (when (>= namelen 2)
-                (flet
-                  ((number-char (name base lg-base)
-                     (let ((n 0))
-                       (dotimes (i (length name) (code-char n))
-                         (let ((code (digit-char-p (char name i) base)))
-                           (if code
-                             (setq n (logior code (ash n lg-base)))
-                             (return)))))))
-                  (case (char name 0)
-                    (#\^
-                     (when (= namelen 2)
-                       (code-char (the fixnum (logxor (the fixnum (char-code (char-upcase (char name 1)))) #x40)))))
-                    ((#\x #\X #\u #\U)
-                     (number-char (subseq name 1) 16 4))
-                    ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)
-                     (number-char name 8 3))))))))))
-  
-  (eval-when (:compile-toplevel :load-toplevel :execute)
-    (setq *warn-if-redefine* t)
-    (setq *warn-if-redefine-kernel* t)))
-
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; READER SYNTAX
-
-; Define #?num to produce a character with code given by the hexadecimal number num.
-; (This is a portable extension; the #\u syntax installed above does the same thing
-; but is not portable.)
-(set-dispatch-macro-character
- #\# #\?
- #'(lambda (stream subchar arg)
-     (declare (ignore subchar arg))
-     (let ((*read-base* 16))
-       (code-char (read stream t nil t)))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; MACROS
-
-; (list*-bind (var1 var2 ... varn) expr body):
-;   evaluates expr to obtain a value v;
-;   binds var1, var2, ..., varn such that (list* var1 var2 ... varn) is equal to v;
-;   evaluates body with these bindings;
-;   returns the result values from the body.
-(defmacro list*-bind ((var1 &rest vars) expr &body body)
-  (labels
-    ((gen-let*-bindings (var1 vars expr)
-       (if vars
-         (let ((expr-var (gensym "REST")))
-           (list*
-            (list expr-var expr)
-            (list var1 (list 'car expr-var))
-            (gen-let*-bindings (car vars) (cdr vars) (list 'cdr expr-var))))
-         (list
-          (list var1 expr)))))
-    (list* 'let* (gen-let*-bindings var1 vars expr) body)))
-
-(set-pprint-dispatch '(cons (member list*-bind))
-                     (pprint-dispatch '(multiple-value-bind () ())))
-
-
-; (multiple-value-map-bind (var1 var2 ... varn) f (src1 src2 ... srcm) body)
-;   evaluates src1, src2, ..., srcm to obtain lists l1, l2, ..., lm;
-;   calls f on corresponding elements of lists l1, ..., lm; each such call should return n values v1 v2 ... vn;
-;   binds var1, var2, ..., varn such var1 is the list of all v1's, var2 is the list of all v2's, etc.;
-;   evaluates body with these bindings;
-;   returns the result values from the body.
-(defmacro multiple-value-map-bind ((&rest vars) f (&rest srcs) &body body)
-  (let ((n (length vars))
-        (m (length srcs))
-        (fun (gensym "F"))
-        (ss nil)
-        (vs nil)
-        (accumulators nil))
-    (dotimes (i n)
-      (push (gensym "V") vs)
-      (push (gensym "ACC") accumulators))
-    (dotimes (i m)
-      (push (gensym "S") ss))
-    `(let ((,fun ,f)
-           ,@(mapcar #'(lambda (acc) (list acc nil)) accumulators))
-       (mapc #'(lambda ,ss
-                 (multiple-value-bind ,vs (funcall ,fun ,@ss)
-                   ,@(mapcar #'(lambda (accumulator v) (list 'push v accumulator))
-                             accumulators vs)))
-             ,@srcs)
-       (let ,(mapcar #'(lambda (var accumulator) (list var (list 'nreverse accumulator)))
-                     vars accumulators)
-         ,@body))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; VALUE ASSERTS
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defconstant *value-asserts* t))
-
-; Assert that (test value) returns non-nil.  Return value.
-(defmacro assert-value (value test &rest format-and-parameters)
-  (if *value-asserts*
-    (let ((v (gensym "VALUE")))
-      `(let ((,v ,value))
-         (unless (,test ,v)
-           ,(if format-and-parameters
-              `(error ,@format-and-parameters)
-              `(error "~S doesn't satisfy ~S" ',value ',test)))
-         ,v))
-    value))
-
-
-; Assert that value is non-nil.  Return value.
-(defmacro assert-non-null (value &rest format-and-parameters)
-  `(assert-value ,value identity .
-                 ,(or format-and-parameters
-                      `("~S is null" ',value))))
-
-
-; Assert that value is non-nil.  Return nil.
-; Do not evaluate value in nondebug versions.
-(defmacro assert-true (value &rest format-and-parameters)
-  (if *value-asserts*
-    `(unless ,value
-       ,(if format-and-parameters
-          `(error ,@format-and-parameters)
-          `(error "~S is false" ',value)))
-    nil))
-
-
-; Assert that expr returns n values.  Return those values.
-(defmacro assert-n-values (n expr)
-  (if *value-asserts*
-    (let ((v (gensym "VALUES")))
-      `(let ((,v (multiple-value-list ,expr)))
-         (unless (= (length ,v) ,n)
-           (error "~S returns ~D values instead of ~D" ',expr (length ,v) ',n))
-         (values-list ,v)))
-    expr))
-
-; Assert that expr returns one value.  Return that value.
-(defmacro assert-one-value (expr)
-  `(assert-n-values 1 ,expr))
-
-; Assert that expr returns two values.  Return those values.
-(defmacro assert-two-values (expr)
-  `(assert-n-values 2 ,expr))
-
-; Assert that expr returns three values.  Return those values.
-(defmacro assert-three-values (expr)
-  `(assert-n-values 3 ,expr))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; STRUCTURED TYPES
-
-(defconstant *type-asserts* t)
-
-(defun tuple? (value structured-types)
-  (if (endp structured-types)
-    (null value)
-    (and (consp value)
-         (structured-type? (car value) (first structured-types))
-         (tuple? (cdr value) (rest structured-types)))))
-
-(defun list-of? (value structured-type)
-  (or
-   (null value)
-   (and (consp value)
-        (structured-type? (car value) structured-type)
-        (list-of? (cdr value) structured-type))))
-
-
-; Return true if value has the given structured-type.
-; A structured-type can be a Common Lisp type or one of the forms below:
-;
-;   (cons t1 t2)  is the type of pairs whose car has structured-type t1 and
-;                 cdr has structured-type t2.
-;
-;   (tuple t1 t2 ... tn) is the type of n-element lists whose first element
-;                 has structured-type t1, second element has structured-type t2, ...,
-;                 and last element has structured-type tn.
-;
-;   (list t)      is the type of lists all of whose elements have structured-type t.
-;
-(defun structured-type? (value structured-type)
-  (cond
-   ((consp structured-type)
-    (case (first structured-type)
-      (cons (and (consp value)
-                 (structured-type? (car value) (second structured-type))
-                 (structured-type? (cdr value) (third structured-type))))
-      (tuple (tuple? value (rest structured-type)))
-      (list (list-of? value (second structured-type)))
-      (t (typep value structured-type))))
-   ((null structured-type) nil)
-   (t (typep value structured-type))))
-
-
-; Ensure that value has type given by typespec
-; (which should not be quoted).  Return the value.
-(defmacro assert-type (value structured-type)
-  (if *type-asserts*
-    (let ((v (gensym "VALUE")))
-      `(let ((,v ,value))
-         (unless (structured-type? ,v ',structured-type)
-           (error "~S should have type ~S" ,v ',structured-type))
-         ,v))
-    value))
-
-(deftype bool () '(member nil t))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; GENERAL UTILITIES
-
-
-; f must be either a function, a symbol, or a list of the form (setf <symbol>).
-; If f is a function or has a function binding, return that function; otherwise return nil.
-(defun callable (f)
-  (cond
-   ((functionp f) f)
-   ((fboundp f) (fdefinition f))
-   (t nil)))
-
-
-; Return the first character of symbol's name or nil if s's name has zero length.
-(defun first-symbol-char (symbol)
-  (let ((name (symbol-name symbol)))
-    (when (> (length name) 0)
-      (char name 0))))
-
-
-(defconstant *get2-nonce* (if (boundp '*get2-nonce*) (symbol-value '*get2-nonce*) (gensym)))
-
-; Perform a get except that return two values:
-;   The value returned from the get or nil if the property is not present
-;   t if the property is present or nil if not.
-(defun get2 (symbol property)
-  (let ((value (get symbol property *get2-nonce*)))
-    (if (eq value *get2-nonce*)
-      (values nil nil)
-      (values value t))))
-
-
-; Return a list of all the keys in the hash table.
-(defun hash-table-keys (hash-table)
-  (let ((keys nil))
-    (maphash #'(lambda (key value)
-                 (declare (ignore value))
-                 (push key keys))
-             hash-table)
-    keys))
-
-
-; Return a list of all the keys in the hash table sorted by their string representations.
-(defun sorted-hash-table-keys (hash-table)
-  (with-standard-io-syntax
-    (let ((*print-readably* nil)
-          (*print-escape* nil))
-      (sort (hash-table-keys hash-table) #'string<
-            :key #'(lambda (item)
-                     (if (symbolp item)
-                       (or (get item :sort-key)
-                           (symbol-name item))
-                       (write-to-string item)))))))
-
-
-; Return an association list of all the entries in the hash table.
-(defun hash-table-entries (hash-table)
-  (let ((entries nil))
-    (maphash #'(lambda (key value)
-                 (push (cons key value) entries))
-             hash-table)
-    entries))
-
-
-; Return true if the two hash tables are equal, using the given equality test for testing their elements.
-(defun hash-table-= (hash-table1 hash-table2 &key (test #'eql))
-  (and (= (hash-table-count hash-table1) (hash-table-count hash-table2))
-       (progn
-         (maphash
-          #'(lambda (key1 value1)
-              (multiple-value-bind (value2 present2) (gethash key1 hash-table2)
-                (unless (and present2 (funcall test value1 value2))
-                  (return-from hash-table-= nil))))
-          hash-table1)
-         t)))
-
-
-; Given an association list ((key1 . data1) (key2 . data2) ... (keyn datan)),
-; produce another association list whose keys are sets of the keys of the original list,
-; where the data elements of each such set are equal according to the given test function.
-; The keys within each set are listed in the same order as in the original list.
-; Set X comes before set Y if X contains a key earlier in the original list than any
-; key in Y.
-(defun collect-equivalences (alist &key (test #'eql))
-  (if (endp alist)
-    nil
-    (let* ((element (car alist))
-           (key (car element))
-           (data (cdr element))
-           (rest (cdr alist)))
-      (if (rassoc data rest :test test)
-        (let ((filtered-rest nil)
-              (additional-keys nil))
-          (dolist (elt rest)
-            (if (funcall test data (cdr elt))
-              (push (car elt) additional-keys)
-              (push elt filtered-rest)))
-          (acons (cons key (nreverse additional-keys)) data
-                 (collect-equivalences (nreverse filtered-rest) :test test)))
-        (acons (list key) data (collect-equivalences rest :test test))))))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; BITMAPS
-
-; Treating integer m as a bitmap, call f on the number of each bit set in m.
-(defun bitmap-each-bit (f m)
-  (assert-true (>= m 0))
-  (dotimes (i (integer-length m))
-    (when (logbitp i m)
-      (funcall f i))))
-
-  
-; Treating integer m as a bitmap, return a sorted list of disjoint, nonadjacent ranges
-; of bits set in m.  Each range is a pair (x . y) and indicates that bits numbered x through
-; y, inclusive, are set in m.  If m is negative, the last range will be a pair (x . :infinity).
-(defun bitmap-to-ranges (m)
-  (labels
-    ((bitmap-to-ranges-sub (m ranges)
-       (if (zerop m)
-         ranges
-         (let* ((hi (integer-length m))
-                (m (- m (ash 1 hi)))
-                (lo (integer-length m))
-                (m (+ m (ash 1 lo))))
-           (bitmap-to-ranges-sub m (acons lo (1- hi) ranges))))))
-    (if (minusp m)
-      (let* ((lo (integer-length m))
-             (m (+ m (ash 1 lo))))
-        (bitmap-to-ranges-sub m (list (cons lo :infinity))))
-      (bitmap-to-ranges-sub m nil))))
-
-
-; Same as bitmap-to-ranges but abbreviate pairs (x . x) by x.
-(defun bitmap-to-abbreviated-ranges (m)
-  (mapcar #'(lambda (range)
-              (if (eql (car range) (cdr range))
-                (car range)
-                range))
-          (bitmap-to-ranges m)))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; PACKAGES
-
-; Call f on each external symbol defined in the package.
-(defun each-package-external-symbol (package f)
-  (with-package-iterator (iter package :external)
-    (loop
-      (multiple-value-bind (present symbol) (iter)
-        (unless present
-          (return))
-        (funcall f symbol)))))
-
-
-; Return a list of all external symbols defined in the package.
-(defun package-external-symbols (package)
-  (with-package-iterator (iter package :external)
-    (let ((list nil))
-      (loop
-        (multiple-value-bind (present symbol) (iter)
-          (unless present
-            (return))
-          (push symbol list)))
-      list)))
-
-
-; Return a sorted list of all external symbols defined in the package.
-(defun sorted-package-external-symbols (package)
-  (sort (package-external-symbols package) #'string<))
-
-
-; Call f on each internal symbol defined in the package.
-(defun each-package-internal-symbol (package f)
-  (with-package-iterator (iter package :internal)
-    (loop
-      (multiple-value-bind (present symbol) (iter)
-        (unless present
-          (return))
-        (funcall f symbol)))))
-
-
-; Return a list of all internal symbols defined in the package.
-(defun package-internal-symbols (package)
-  (with-package-iterator (iter package :internal)
-    (let ((list nil))
-      (loop
-        (multiple-value-bind (present symbol) (iter)
-          (unless present
-            (return))
-          (push symbol list)))
-      list)))
-
-
-; Return a sorted list of all internal symbols defined in the package.
-(defun sorted-package-internal-symbols (package)
-  (sort (package-internal-symbols package) #'string<))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; INTSETS
-
-;;; An intset is a finite set of integers, represented as an ordered list of ranges.
-;;; Each range is a cons (low . high), both low and high being inclusive.  Ranges must
-;;; be nonoverlapping, and adjacent ranges must be consolidated.
-
-(defconstant *empty-intset* nil)
-
-; Return true if the intset is valid.
-(defun valid-intset? (intset)
-  (and (structured-type? intset '(list (cons integer integer)))
-       (or (null intset)
-           (let ((prev (- (caar intset) 2)))
-             (dolist (range intset t)
-               (let ((low (car range))
-                     (high (cdr range)))
-                 (unless (and (< prev (1- low)) (<= low high))
-                   (return nil))
-                 (setq prev high)))))))
-
-
-; Return an intset that is the union of the given intset and the intset
-; containg the given values.
-(defun intset-add-value (intset &rest values)
-  (labels
-    ((add-value (intset value)
-       (if (endp intset)
-         (list (cons value value))
-         (let* ((first-range (first intset))
-                (rest (rest intset))
-                (first-low (car first-range))
-                (first-high (cdr first-range)))
-           (cond
-            ((> value first-high)
-             (cond
-              ((/= value (1+ first-high)) (cons first-range (add-value rest value)))
-              ((or (endp rest) (/= (caar rest) (1+ value))) (acons first-low value rest))
-              (t (acons first-low (cdar rest) (rest rest)))))
-            ((< value first-low)
-             (if (/= value (1- first-low))
-               (acons value value intset)
-               (acons value first-high rest)))
-            (t intset))))))
-    
-    (dolist (value values)
-      (assert-true (integerp value))
-      (add-value intset value))))
-
-
-; Return an intset that is the union of the given intset and the intset
-; containg all integers between low and high, inclusive.  low <= high+1 is required.
-(defun intset-add-range (intset low high)
-  (labels
-    ((add-range (intset low high)
-       (if (endp intset)
-         (list (cons low high))
-         (let* ((first-range (first intset))
-                (rest (rest intset))
-                (first-low (car first-range))
-                (first-high (cdr first-range)))
-           (cond
-            ((> low (1+ first-high))
-             (cons first-range (add-range rest low high)))
-            ((< high (1- first-low))
-             (acons low high intset))
-            ((<= high first-high)
-             (if (>= low first-low)
-               intset
-               (acons low first-high rest)))
-            (t (add-range rest (min low first-low) high)))))))
-    
-    (assert-true (and (integerp low) (integerp high) (<= low (1+ high))))
-    (if (= low (1+ high))
-      intset
-      (add-range intset low high))))
-
-
-; Return an intset constructed from a list of ranges.  Each range has two expressions,
-; low and high.  high can be null to indicate a one-element range.
-(defun intset-from-ranges (&rest ranges)
-  (if (endp ranges)
-    *empty-intset*
-    (progn
-      (assert-true (cdr ranges))
-      (intset-add-range (apply #'intset-from-ranges (cddr ranges))
-                        (first ranges)
-                        (or (second ranges) (first ranges))))))
-
-
-
-; Return true if value is a member of the intset.
-(defun intset-member? (intset value)
-  (if (endp intset)
-    nil
-    (let ((first-range (first intset)))
-      (if (> value (cdr first-range))
-        (intset-member? (rest intset) value)
-        (>= value (car first-range))))))
-
-
-; Return the union of the two intsets.
-(defun intset-union (intset1 intset2)
-  (cond
-   ((endp intset1) intset2)
-   ((endp intset2) intset1)
-   (t (let* ((first-range1 (first intset1))
-             (rest1 (rest intset1))
-             (first-low1 (car first-range1))
-             (first-high1 (cdr first-range1))
-             (first-range2 (first intset2))
-             (rest2 (rest intset2))
-             (first-low2 (car first-range2))
-             (first-high2 (cdr first-range2)))
-        (cond
-         ((< first-high1 (1- first-low2))
-          (cons first-range1 (intset-union rest1 intset2)))
-         ((< first-high2 (1- first-low1))
-          (cons first-range2 (intset-union intset1 rest2)))
-         (t (intset-union (intset-add-range intset1 first-low2 first-high2) rest2)))))))
-
-
-; Return the intersection of the two intsets.
-(defun intset-intersection (intset1 intset2)
-  (if (or (endp intset1) (endp intset2))
-    nil
-    (let* ((first-range1 (first intset1))
-           (rest1 (rest intset1))
-           (first-low1 (car first-range1))
-           (first-high1 (cdr first-range1))
-           (first-range2 (first intset2))
-           (rest2 (rest intset2))
-           (first-low2 (car first-range2))
-           (first-high2 (cdr first-range2))
-           (low (max first-low1 first-low2)))
-      (cond
-       ((< first-high1 first-high2)
-        (if (<= low first-high1)
-          (acons low first-high1 (intset-intersection rest1 intset2))
-          (intset-intersection rest1 intset2)))
-       ((> first-high1 first-high2)
-        (if (<= low first-high2)
-          (acons low first-high2 (intset-intersection intset1 rest2))
-          (intset-intersection intset1 rest2)))
-       (t (acons low first-high1 (intset-intersection rest1 rest2)))))))
-
-
-; Return the the intset containing the elements of intset1 that are not in intset2.
-(defun intset-difference (intset1 intset2)
-  (cond
-   ((endp intset1) nil)
-   ((endp intset2) intset1)
-   (t (let* ((first-range1 (first intset1))
-             (rest1 (rest intset1))
-             (first-low1 (car first-range1))
-             (first-high1 (cdr first-range1))
-             (first-range2 (first intset2))
-             (rest2 (rest intset2))
-             (first-low2 (car first-range2))
-             (first-high2 (cdr first-range2)))
-        (cond
-         ((< first-high1 first-low2)
-          (cons first-range1 (intset-difference rest1 intset2)))
-         ((> first-low1 first-high2)
-          (intset-difference intset1 rest2))
-         ((< first-low1 first-low2)
-          (acons first-low1 (1- first-low2) (intset-difference (acons first-low2 first-high1 rest1) intset2)))
-         ((> first-high1 first-high2)
-          (intset-difference (acons (1+ first-high2) first-high1 rest1) rest2))
-         (t (intset-difference rest1 intset2)))))))
-
-
-; Return true if the two intsets are equal.
-(declaim (inline intset=))
-(defun intset= (intset1 intset2)
-  (equal intset1 intset2))
-
-
-; Return the number of elements in the intset.
-(defun intset-length (intset)
-  (if (endp intset)
-    0
-    (+ 1 (- (cdar intset) (caar intset))
-       (intset-length (rest intset)))))
-
-
-; Return the lowest element of the intset or nil if the intset is empty.
-(declaim (inline intset-min))
-(defun intset-min (intset)
-  (caar intset))
-
-
-; Return the highest element of the intset or nil if the intset is empty.
-(defun intset-max (intset)
-  (cdar (last intset)))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; PARTIAL ORDERS
-
-(defstruct partial-order
-  (next-number 0 :type integer))  ;Bit number to use for next element
-
-
-(defstruct (partial-order-element (:constructor make-partial-order-element (partial-order number predecessor-bitmap))
-                                  (:copier nil)
-                                  (:predicate partial-order-element?))
-  (partial-order nil :type partial-order)  ;Partial order to which this element belongs
-  (number nil :type integer)               ;Bit number of this element
-  (predecessor-bitmap nil :type integer))  ;Bitmap of elements less than or equal to this one in the partial order
-
-
-; Construct a new unique element in the partial order that is greater than the
-; given predecessors.  Return that element.
-(defun partial-order-add-element (partial-order &rest predecessors)
-  (let* ((number (partial-order-next-number partial-order))
-         (predecessor-bitmap (ash 1 number)))
-    (dolist (predecessor predecessors)
-      (assert-true (eq (partial-order-element-partial-order predecessor) partial-order))
-      (setq predecessor-bitmap (logior predecessor-bitmap (partial-order-element-predecessor-bitmap predecessor))))
-    (incf (partial-order-next-number partial-order))
-    (make-partial-order-element partial-order number predecessor-bitmap)))
-
-
-(defmacro def-partial-order-element (partial-order name &rest predecessors)
-  `(defparameter ,name (partial-order-add-element ,partial-order ,@predecessors)))
-
-
-; Return true if element1 is greater than or equal to element2 in this partial order.
-(defun partial-order->= (element1 element2)
-  (assert-true (eq (partial-order-element-partial-order element1) (partial-order-element-partial-order element2)))
-  (logbitp (partial-order-element-number element2) (partial-order-element-predecessor-bitmap element1)))
-
-
-; Return true if element1 is less than element2 in this partial order.
-(declaim (inline partial-order-<))
-(defun partial-order-< (element1 element2)
-  (not (partial-order->= element1 element2)))
-
-
-;;; ------------------------------------------------------------------------------------------------------
-;;; DEPTH-FIRST SEARCH
-
-; Return a depth-first-ordered list of the nodes in a directed graph.
-; The graph may contain cycles, so a general depth-first search is used.
-; start is the start node.
-; successors is a function that takes a node and returns a list of that
-;   node's successors.
-; test is a function that takes two nodes and returns true if they are
-;   the same node.  test should be either #'eq, #'eql, or #'equal
-;   because it is used as a test function in a hash table.
-(defun depth-first-search (test successors start)
-  (let ((visited-nodes (make-hash-table :test test))
-        (dfs-list nil))
-    (labels
-      ((visit (node)
-         (setf (gethash node visited-nodes) t)
-         (dolist (successor (funcall successors node))
-           (unless (gethash successor visited-nodes)
-             (visit successor)))
-         (push node dfs-list)))
-      (visit start)
-      dfs-list)))

mozilla/js2/semantics/styles.css

@@ -1,72 +0,0 @@
-A:link {color: #0000DD}
-A:visited {color: #551188}
-A:hover {color: #3333FF}
-A:active {color: #FF00FF}
-A * {text-decoration: inherit}
-
-.title1 {font-family: "Times New Roman", Times, serif; font-size: 36pt; font-weight: bold; color: #000000; white-space: nowrap}
-.title2 {font-family: "Times New Roman", Times, serif; font-size: 18pt; font-weight: bold; color: #000000; white-space: nowrap}
-.top-title {color: #009900}
-.es-title {color: #999900}
-.draft-title {color: #FF0000}
-.mod-date {font-size: smaller; font-style: italic; text-align: right}
-.sub {font-size: 70%}
-.sub-num {font-size: 70%; font-style: normal}
-.syntax {margin-left: 0.5in}
-.indent {margin-left: 0.5in}
-.issue {color: #FF0000}
-
-BODY {background-color: #FFFFFF; color: #000000}
-DL {margin-left: 18pt}
-DD {margin-bottom: 6pt}
-DT {font-style: italic; margin-top: 3pt}
-
-.js2 {background-color: #FFFF66; color: #000033}
-.js2-hidden {}
-.es4 {background-color: #FFCCCC; color: #333300; text-decoration: line-through}
-.es4-hidden {}
-
-.grammar-rule {margin-left: 18pt; margin-top: 6pt; margin-bottom: 6pt}
-.grammar-lhs {}
-.grammar-rhs {margin-left: 9pt;}
-.grammar-argument {margin-left: 18pt; margin-top: 6pt; margin-bottom: 6pt}
-.semantics {margin-left: 9pt; margin-top: 6pt; margin-bottom: 3pt}
-.semantics-next {margin-left: 27pt; margin-top: 0pt; margin-bottom: 3pt}
-.semantic-comment {margin-left: 9pt; margin-top: 12pt; margin-bottom: 0pt}
-
-.symbol {font-family: Symbol}
-.unicode {font-family: "Lucida Sans Unicode", serif}
-VAR, VAR A:link, VAR A:visited {font-family: Georgia, Palatino, "Times New Roman", Times, serif; font-weight: normal; font-style: italic; color: #336600}
-A:hover VAR, VAR A:hover {color: #003300}
-A:active VAR, VAR A:active {color: #00FF00}
-CODE, PRE {font-family: "Courier New", Courier, mono; color: #0000FF}
-PRE {margin-left: 0.5in}
-A:hover CODE {color: #3333CC}
-A:active CODE {color: #6666FF}
-.control, A.control:link, A.control:visited {font-family: "Times New Roman", Times, serif; font-weight: normal; color: #000099}
-A.control:hover, A:hover .control {color: #333366}
-A.control:active, A:active .control {color: #3333FF}
-.terminal, A.terminal:link, A.terminal:visited {font-family: Georgia, Palatino, "Times New Roman", Times, serif; font-weight: bold; color: #009999}
-A.terminal:hover, A:hover .terminal {color: #336666}
-A.terminal:active, A:active .terminal {color: #00FFFF}
-.terminal-keyword {font-weight: bold}
-.nonterminal, A.nonterminal:link, A.nonterminal:visited, .nonterminal A:link, .nonterminal A:visited {font-family: Georgia, Palatino, "Times New Roman", Times, serif; font-weight: normal; font-style: italic; color: #009900}
-A.nonterminal:hover, .nonterminal A:hover, A:hover .nonterminal {color: #336633}
-A.nonterminal:active, .nonterminal A:active, A:active .nonterminal {color: #00FF00}
-.nonterminal-attribute, .nonterminal-argument {font-style: normal}
-.semantic-keyword {font-family: "Times New Roman", Times, serif; font-weight: bold}
-.type-expression, A.type-expression:link, A.type-expression:visited, .type-name, A.type-name:link, A.type-name:visited {font-family: "Times New Roman", Times, serif; color: #CC0000}
-A.type-expression:hover, A:hover .type-expression, A.type-name:hover, A:hover .type-name {color: #990000}
-A.type-expression:active, A:active .type-expression, A.type-name:active, A:active .type-name {color: #FF6666}
-.type-name {font-variant: small-caps}
-.id-name {font-family: Arial, Helvetica, sans-serif; font-variant: small-caps}
-.field-name, A.field-name:link, A.field-name:visited {font-family: Arial, Helvetica, sans-serif; color: #FF0000}
-A.field-name:hover, A:hover .field-name {color: #CC3333}
-A.field-name:active, A:active .field-name {color: #FF6666}
-.global-variable, A.global-variable:link, A.global-variable:visited {font-family: "Times New Roman", Times, serif; color: #006600}
-.local-variable, A.local-variable:link, A.local-variable:visited {font-family: "Times New Roman", Times, serif; color: #009900}
-A.global-variable:hover, A:hover .global-variable, A.local-variable:hover, A:hover .local-variable {color: #336633}
-A.global-variable:active, A:active .global-variable, A.local-variable:active, A:active .local-variable {color: #00FF00}
-.action-name, A.action-name:link, A.action-name:visited {font-family: "Zapf Chancery", "Comic Sans MS", Script, serif; color: #660066}
-A.action-name:hover, A:hover .action-name {color: #663366}
-A.action-name:active, A:active .action-name {color: #FF00FF}

mozilla/js2/semantics/unicodeCompatibility.js

@@ -1,124 +0,0 @@
-// Most browsers don't support unicode mathematical symbols yet.
-// As a workaround, this code maps them to the Symbol font using
-// either the ISO-8859-1 or ISO-8859-1-to-MacRoman inverse mapping.
-
-var mapping_Unicode = 0; // Output true unicode
-var mapping_Win = 1;     // Emulate using Windows Symbol font
-var mapping_Mac = 2;     // Emulate using Mac Symbol font
-
-// CSS class names to use depending on the mapping
-var cssClassNames = ["", "symbol", "symbol"];
-
-
-var mapping;
-if (parseFloat(navigator.appVersion) >= 5)
-  mapping = mapping_Unicode;
-else if (navigator.platform.indexOf("Mac") != -1)
-  mapping = mapping_Mac;
-else
-  mapping = mapping_Win;
-
-function defMap(unicode, win, mac) {
-  if (cssClassNames[mapping] == "")
-    return '&#' + arguments[mapping] + ';';
-  else
-    return '<SPAN class="' + cssClassNames[mapping] + '">&#' + arguments[mapping] + ';</SPAN>';
-}
-
-
-var U_times =   defMap(0x00D7, 0xB4, 0xA5);
-
-var U_Alpha =   defMap(0x0391, 0x41, 0x41);
-var U_Beta =    defMap(0x0392, 0x42, 0x42);
-var U_Gamma =   defMap(0x0393, 0x47, 0x47);
-var U_Delta =   defMap(0x0394, 0x44, 0x44);
-var U_Epsilon = defMap(0x0395, 0x45, 0x45);
-var U_Zeta =    defMap(0x0396, 0x5A, 0x5A);
-var U_Eta =     defMap(0x0397, 0x48, 0x48);
-var U_Theta =   defMap(0x0398, 0x51, 0x51);
-var U_Iota =    defMap(0x0399, 0x49, 0x49);
-var U_Kappa =   defMap(0x039A, 0x4B, 0x4B);
-var U_Lambda =  defMap(0x039B, 0x4C, 0x4C);
-var U_Mu =      defMap(0x039C, 0x4D, 0x4D);
-var U_Nu =      defMap(0x039D, 0x4E, 0x4E);
-var U_Xi =      defMap(0x039E, 0x58, 0x58);
-var U_Omicron = defMap(0x039F, 0x4F, 0x4F);
-var U_Pi =      defMap(0x03A0, 0x50, 0x50);
-var U_Rho =     defMap(0x03A1, 0x52, 0x52);
-var U_Sigma =   defMap(0x03A3, 0x53, 0x53);
-var U_Tau =     defMap(0x03A4, 0x54, 0x54);
-var U_Upsilon = defMap(0x03A5, 0x55, 0x55);
-var U_Phi =     defMap(0x03A6, 0x46, 0x46);
-var U_Chi =     defMap(0x03A7, 0x43, 0x43);
-var U_Psi =     defMap(0x03A8, 0x59, 0x59);
-var U_Omega =   defMap(0x03A9, 0x57, 0x57);
-
-var U_alpha =   defMap(0x03B1, 0x61, 0x61);
-var U_beta =    defMap(0x03B2, 0x62, 0x62);
-var U_gamma =   defMap(0x03B3, 0x67, 0x67);
-var U_delta =   defMap(0x03B4, 0x64, 0x64);
-var U_epsilon = defMap(0x03B5, 0x65, 0x65);
-var U_zeta =    defMap(0x03B6, 0x7A, 0x7A);
-var U_eta =     defMap(0x03B7, 0x68, 0x68);
-var U_theta =   defMap(0x03B8, 0x71, 0x71);
-var U_iota =    defMap(0x03B9, 0x69, 0x69);
-var U_kappa =   defMap(0x03BA, 0x6B, 0x6B);
-var U_lambda =  defMap(0x03BB, 0x6C, 0x6C);
-var U_mu =      defMap(0x03BC, 0x6D, 0x6D);
-var U_nu =      defMap(0x03BD, 0x6E, 0x6E);
-var U_xi =      defMap(0x03BE, 0x78, 0x78);
-var U_omicron = defMap(0x03BF, 0x6F, 0x6F);
-var U_pi =      defMap(0x03C0, 0x70, 0x70);
-var U_rho =     defMap(0x03C1, 0x72, 0x72);
-var U_sigma =   defMap(0x03C3, 0x73, 0x73);
-var U_tau =     defMap(0x03C4, 0x74, 0x74);
-var U_upsilon = defMap(0x03C5, 0x75, 0x75);
-var U_phi =     defMap(0x03C6, 0x66, 0x66);
-var U_chi =     defMap(0x03C7, 0x63, 0x63);
-var U_psi =     defMap(0x03C8, 0x79, 0x79);
-var U_omega =   defMap(0x03C9, 0x77, 0x77);
-
-var U_bull =    defMap(0x2022, 0xB7, 0x2211);
-
-var U_larr =    defMap(0x2190, 0xAC, 0xA8);
-var U_uarr =    defMap(0x2191, 0xAD, 0x2260);
-var U_rarr =    defMap(0x2192, 0xAE, 0xC6);
-var U_darr =    defMap(0x2193, 0xAF, 0xD8);
-var U_harr =    defMap(0x2194, 0xAB, 0xB4);
-var U_lArr =    defMap(0x21D0, 0xDC, 0x2039);
-var U_uArr =    defMap(0x21D1, 0xDD, 0x203A);
-var U_rArr =    defMap(0x21D2, 0xDE, 0xFB01);
-var U_dArr =    defMap(0x21D3, 0xDF, 0xFB02);
-var U_hArr =    defMap(0x21D4, 0xDB, 0x20AC);
-
-var U_forall =  defMap(0x2200, 0x22, 0x22);
-var U_exist =   defMap(0x2203, 0x24, 0x24);
-var U_empty =   defMap(0x2205, 0xC6, 0x2206);
-var U_isin =    defMap(0x2208, 0xCE, 0x0152);
-var U_notin =   defMap(0x2209, 0xCF, 0x0153);
-var U_infin =   defMap(0x221E, 0xA5, 0x2022);
-var U_and =     defMap(0x2227, 0xD9, 0x0178);
-var U_or =      defMap(0x2228, 0xDA, 0x2044);
-var U_cap =     defMap(0x2229, 0xC7, 0xAB);
-var U_cup =     defMap(0x222A, 0xC8, 0xBB);
-var U_cong =    defMap(0x2245, 0x40, 0x40);
-var U_asymp =   defMap(0x2248, 0xBB, 0xAA);
-var U_ne =      defMap(0x2260, 0xB9, 0x03C0);
-var U_equiv =   defMap(0x2261, 0xBA, 0x222B);
-var U_le =      defMap(0x2264, 0xA3, 0xA3);
-var U_ge =      defMap(0x2265, 0xB3, 0x2265);
-var U_sub =     defMap(0x2282, 0xCC, 0xC3);
-var U_sup =     defMap(0x2283, 0xC9, 0x2026);
-var U_nsub =    defMap(0x2284, 0xCB, 0xC0);
-var U_sube =    defMap(0x2286, 0xCD, 0xD5);
-var U_supe =    defMap(0x2287, 0xCA, 0xA0); //Mac Navigator confuses it with nbsp
-var U_oplus =   defMap(0x2295, 0xC5, 0x2248);
-var U_otimes =  defMap(0x2297, 0xC4, 0x0192);
-var U_perp =    defMap(0x22A5, 0x5E, 0x5E);
-
-var U_lceil =   defMap(0x2308, 0xE9, 0xC8);
-var U_rceil =   defMap(0x2309, 0xF9, 0x02D8);
-var U_lfloor =  defMap(0x230A, 0xEB, 0xCE);
-var U_rfloor =  defMap(0x230B, 0xFB, 0x02DA);
-var U_lang =    defMap(0x2329, 0xE1, 0xB7);
-var U_rang =    defMap(0x232A, 0xF1, 0xD2);

mozilla/js2/src/JSILGenerator.cpp

@@ -1,417 +0,0 @@
-#pragma warning ( disable : 4786 )
-
-#include "Nodes.h"
-#include "JSILGenerator.h"
-#include "../jsc/src/cpp/parser/NodeFactory.h"
-#include "ReferenceValue.h"
-#include "ConstantEvaluator.h"
-#include "Builder.h"
-#include "GlobalObjectBuilder.h"
-
-namespace esc {
-namespace v1 {
-
-    JavaScript::ICG::ICodeModule* JSILGenerator::emit() {
-        return 0;
-    }
-
-	// Evaluators
-
-    // Base node
-    
-	Value* JSILGenerator::evaluate( Context& cx, Node* node ) { 
-        throw;
-    }
-
-	// Expression evaluators
-
-    Value* JSILGenerator::evaluate( Context& cx, ThisExpressionNode* node ) { 
-		throw;
-    }
-    
-	/*
-	 * Unqualified identifiers evaluate to a ReferenceValue during semantic analysis,
-	 * and so this method is never called.
-	 */
-	
-	Value* JSILGenerator::evaluate( Context& cx, IdentifierNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, QualifiedIdentifierNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, LiteralBooleanNode* node ) { 
-        throw;
-    }
-
-    Value* JSILGenerator::evaluate( Context& cx, LiteralNumberNode* node ) { 
-        throw;
-    }
-
-	/*
-	 * Literal string
-	 */
-	
-	Value* JSILGenerator::evaluate( Context& cx, LiteralStringNode* node ) { 
-        return 0;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, LiteralUndefinedNode* node ) {
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, LiteralRegExpNode* node ) {
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, UnitExpressionNode* node ) {
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, FunctionExpressionNode* node ) {
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ParenthesizedExpressionNode* node ) {
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ParenthesizedListExpressionNode* node ) {
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, LiteralObjectNode* node ) {
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, LiteralFieldNode* node ) {
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, LiteralArrayNode* node ) {
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, PostfixExpressionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, NewExpressionNode* node ) { 
-        throw;
-    }
-    
-	/*
-	 * Indexed member expressions evaluate to a ReferenceValue during semantic analysis,
-	 * and so this method is never called.
-	 */
-
-	Value* JSILGenerator::evaluate( Context& cx, IndexedMemberExpressionNode* node ) {
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ClassofExpressionNode* node ) {
-        throw;
-    }
-    
-	/*
-	 * Member expressions evaluate to a ReferenceValue during semantic analysis,
-	 * and so this method is never called.
-	 */
-
-	Value* JSILGenerator::evaluate( Context& cx, MemberExpressionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, CoersionExpressionNode* node ) { 
-        throw;
-    }
-
-	/*
-	 * CallExpressionNode
-	 *
-	 * Call expressions can be generated as invocations of the function
-	 * object's call method, or as a direct call to a native function.
-	 * If constant evaluation was able to resolve the function reference
-	 * to a built-in native function, then call a direct call is generated.
-	 *
-	 * NOTE: this code is being generated into the start function with
-	 *       parameters (Stack scope, ObjectValue this). These are in
-	 *       local registers (0 and 1).
-	 */
-
-	Value* JSILGenerator::evaluate( Context& cx, CallExpressionNode* node ) { 
-		return 0;
-    }
-    
-	/*
-	 * GetExpressionNode
-	 *
-	 * Get expressions are psuedo syntactic constructs, created when
-	 * a member expression is used in a context where a value is
-	 * expected. In the general case, a get expression is the same as
-	 * a call expression with no arguments. In specfic cases, a get
-	 * expression can be optimized as a direct access of a native 
-	 * field.
-	 */
-
-	/* 
-	 * What do we need to compile a variable reference to a field id?
-	 * the name and the class that defines it. Instance variables would
-	 * be instance fields of the Global prototype object. The runtime
-	 * version of this object would have the native field that implements
-	 * that variable.
-	 *
-	 * get x ();
-	 *
-	 * 1 aload_1							// get the target object value
-	 * 2 getfield #3 <Field int _values_[]>	// get the property values array
-	 * 5 iconst_0							// get the index of value
-	 * 6 iaload								// load the value from values
-	 */
-		
-	Value* JSILGenerator::evaluate( Context& cx, GetExpressionNode* node ) { 
-		return 0;
-    }
-    
-	/*
-	 * SetExpressionNode
-	 *
-	 * Set expressions are psuedo syntactic constructs, created when
-	 * a member expression is used in a context where a storage location
-	 * is expected. In the general case, a set expression is the same as
-	 * a call expression with one argument (the value to be stored.) In 
-	 * specfic cases, a get expression can be optimized as a direct access 
-	 * of a native field.
-	 *
-	 * set x (value);
-     *
-	 * 1 aload_1							// get the target object value
-	 * 2 getfield #3 <Field int values[]>	// get the property values array
-	 * 5 iconst_0							// get the index of the value
-	 * 6 iconst_5							// get the value
-	 * 7 iastore							// store the value in values
-	 */
-
-	Value* JSILGenerator::evaluate( Context& cx, SetExpressionNode* node ) { 
-		return 0;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, UnaryExpressionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, BinaryExpressionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ConditionalExpressionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, AssignmentExpressionNode* node ) { 
-        throw;
-    }
-    
-	/*
-	 * Generate the code for a list (e.g. argument list). The owner of this node
-	 * has already allocated a fixed size array. This function stuffs the list
-	 * values into that array.
-	 */
-	
-	int list_index;
-	int list_array_register;
-
-	Value* JSILGenerator::evaluate( Context& cx, ListNode* node ) { 
-		return 0;
-    }
-
-    // Statements
-
-    Value* JSILGenerator::evaluate( Context& cx, StatementListNode* node ) { 
-		return ObjectValue::undefinedValue;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, EmptyStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ExpressionStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, AnnotatedBlockNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, LabeledStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, IfStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, SwitchStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, CaseLabelNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, DoStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, WhileStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ForInStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ForStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, WithStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ContinueStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, BreakStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ReturnStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ThrowStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, TryStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, CatchClauseNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, FinallyClauseNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, UseStatementNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, IncludeStatementNode* node ) { 
-        throw;
-    }
-
-    // Definitions
-
-    Value* JSILGenerator::evaluate( Context& cx, ImportDefinitionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ImportBindingNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, AnnotatedDefinitionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, AttributeListNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ExportDefinitionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ExportBindingNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, VariableDefinitionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, VariableBindingNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, TypedVariableNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, FunctionDefinitionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, FunctionDeclarationNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, FunctionNameNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, FunctionSignatureNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ParameterNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, OptionalParameterNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ClassDefinitionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, ClassDeclarationNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, InheritanceNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, NamespaceDefinitionNode* node ) { 
-        throw;
-    }
-    
-	Value* JSILGenerator::evaluate( Context& cx, PackageDefinitionNode* node ) { 
-        throw;
-    }
-
-    Value* JSILGenerator::evaluate( Context& cx, ProgramNode* node ) {
-        throw;
-    }
-
-    /*
-     * Test driver
-     */
-
-}
-}
-
-/*
- * Written by Jeff Dyer
- * Copyright (c) 1998-2001 by Mountain View Compiler Company
- * All rights reserved.
- */

mozilla/js2/src/JSILGenerator.h

@@ -1,136 +0,0 @@
-/*
- * JSILGenerator
- */
-
-#ifndef JSILGenerator_h
-#define JSILGenerator_h
-
-#include <vector>
-
-#include "Value.h"
-#include "Context.h"
-#include "Evaluator.h"
-#include "icodegenerator.h"
-//#include "ByteCodeFactory.h"
-//#include "ClassFileConstants.h"
-
-namespace esc {
-namespace v1 {
-
-    class JavaScript::ICG::ICodeModule;
-
-using namespace esc::v1;
-
-class JSILGenerator : public Evaluator /*, private ByteCodeFactory*/ {
-
-public:
-
-	/*
-	 * Test driver
-	 */
-
-    static int main(int argc, char* argv[]);
-
-	/* Create a JSILGenerator object for each ICode module.
-	 */
-
-	JSILGenerator(std::string scriptname) {
-	}
-
-	~JSILGenerator() {
-	}
-
-    JavaScript::ICG::ICodeModule* emit();
-
-	// Base node
-    
-	Value* evaluate( Context& cx, Node* node );
-
-	// 3rd Edition features
-	
-	Value* evaluate( Context& cx, IdentifierNode* node );
-    Value* evaluate( Context& cx, ThisExpressionNode* node );
-    Value* evaluate( Context& cx, LiteralBooleanNode* node );
-    Value* evaluate( Context& cx, LiteralNumberNode* node );
-    Value* evaluate( Context& cx, LiteralStringNode* node );
-    Value* evaluate( Context& cx, LiteralUndefinedNode* node );
-    Value* evaluate( Context& cx, LiteralRegExpNode* node );
-    Value* evaluate( Context& cx, FunctionExpressionNode* node );
-    Value* evaluate( Context& cx, ParenthesizedExpressionNode* node );
-    Value* evaluate( Context& cx, ParenthesizedListExpressionNode* node );
-    Value* evaluate( Context& cx, LiteralObjectNode* node );
-    Value* evaluate( Context& cx, LiteralFieldNode* node );
-    Value* evaluate( Context& cx, LiteralArrayNode* node );
-    Value* evaluate( Context& cx, PostfixExpressionNode* node );
-    Value* evaluate( Context& cx, NewExpressionNode* node );
-    Value* evaluate( Context& cx, IndexedMemberExpressionNode* node );
-    Value* evaluate( Context& cx, MemberExpressionNode* node );
-    Value* evaluate( Context& cx, CallExpressionNode* node );
-    Value* evaluate( Context& cx, GetExpressionNode* node );
-    Value* evaluate( Context& cx, SetExpressionNode* node );
-    Value* evaluate( Context& cx, UnaryExpressionNode* node );
-    Value* evaluate( Context& cx, BinaryExpressionNode* node );
-    Value* evaluate( Context& cx, ConditionalExpressionNode* node );
-    Value* evaluate( Context& cx, AssignmentExpressionNode* node );
-    Value* evaluate( Context& cx, ListNode* node );
-    Value* evaluate( Context& cx, StatementListNode* node );
-    Value* evaluate( Context& cx, EmptyStatementNode* node );
-    Value* evaluate( Context& cx, ExpressionStatementNode* node );
-    Value* evaluate( Context& cx, AnnotatedBlockNode* node );
-    Value* evaluate( Context& cx, LabeledStatementNode* node );
-    Value* evaluate( Context& cx, IfStatementNode* node );
-    Value* evaluate( Context& cx, SwitchStatementNode* node );
-    Value* evaluate( Context& cx, CaseLabelNode* node );
-    Value* evaluate( Context& cx, DoStatementNode* node );
-    Value* evaluate( Context& cx, WhileStatementNode* node );
-    Value* evaluate( Context& cx, ForInStatementNode* node );
-    Value* evaluate( Context& cx, ForStatementNode* node );
-    Value* evaluate( Context& cx, WithStatementNode* node );
-    Value* evaluate( Context& cx, ContinueStatementNode* node );
-    Value* evaluate( Context& cx, BreakStatementNode* node );
-    Value* evaluate( Context& cx, ReturnStatementNode* node );
-    Value* evaluate( Context& cx, ThrowStatementNode* node );
-    Value* evaluate( Context& cx, TryStatementNode* node );
-    Value* evaluate( Context& cx, CatchClauseNode* node );
-    Value* evaluate( Context& cx, FinallyClauseNode* node );
-    Value* evaluate( Context& cx, AnnotatedDefinitionNode* node );
-    Value* evaluate( Context& cx, VariableDefinitionNode* node );
-    Value* evaluate( Context& cx, VariableBindingNode* node );
-    Value* evaluate( Context& cx, FunctionDefinitionNode* node );
-    Value* evaluate( Context& cx, FunctionDeclarationNode* node );
-    Value* evaluate( Context& cx, FunctionNameNode* node );
-    Value* evaluate( Context& cx, FunctionSignatureNode* node );
-    Value* evaluate( Context& cx, ParameterNode* node );
-    Value* evaluate( Context& cx, ProgramNode* node );
-
-	// 4th Edition features
-
-    Value* evaluate( Context& cx, QualifiedIdentifierNode* node );
-    Value* evaluate( Context& cx, UnitExpressionNode* node );
-    Value* evaluate( Context& cx, ClassofExpressionNode* node );
-    Value* evaluate( Context& cx, CoersionExpressionNode* node );
-    Value* evaluate( Context& cx, UseStatementNode* node );
-    Value* evaluate( Context& cx, IncludeStatementNode* node );
-    Value* evaluate( Context& cx, ImportDefinitionNode* node );
-    Value* evaluate( Context& cx, ImportBindingNode* node );
-    Value* evaluate( Context& cx, AttributeListNode* node );
-    Value* evaluate( Context& cx, ExportDefinitionNode* node );
-    Value* evaluate( Context& cx, ExportBindingNode* node );
-    Value* evaluate( Context& cx, TypedVariableNode* node );
-    Value* evaluate( Context& cx, OptionalParameterNode* node );
-    Value* evaluate( Context& cx, ClassDefinitionNode* node );
-    Value* evaluate( Context& cx, ClassDeclarationNode* node );
-    Value* evaluate( Context& cx, InheritanceNode* node );
-    Value* evaluate( Context& cx, NamespaceDefinitionNode* node );
-    Value* evaluate( Context& cx, PackageDefinitionNode* node );
-};
-
-}
-}
-
-#endif // JSILGenerator_h
-
-/*
- * Copyright (c) 1998-2001 by Mountain View Compiler Company
- * All rights reserved.
- */

mozilla/js2/src/Makefile.am

@@ -1,28 +0,0 @@
-include $(top_srcdir)/common.mk
-
-noinst_LIBRARIES = libjs2.a
-
-libjs2_a_DEPENDENCIES = $(LIBFDLIBM)
-
-libjs2_a_SOURCES = \
-	bytecodegen.cpp \
-	collector.cpp \
-	exception.cpp \
-	formatter.cpp \
-	fdlibm_ns.cpp \
-	hash.cpp \
-	js2runtime.cpp \
-	js2execution.cpp \
-	jsarray.cpp \
-	jsmath.cpp \
-	jsstring.cpp \
-	lexer.cpp \
-	mem.cpp \
-	numerics.cpp \
-	parser.cpp \
-	reader.cpp \
-	strings.cpp \
-	tracer.cpp \
-	token.cpp \
-	utilities.cpp \
-	world.cpp

mozilla/js2/src/algo.h

@@ -1,65 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef algo_h___
-#define algo_h___
-
-namespace JavaScript
-{
-//
-// Algorithms
-//
-
-    // Assign zero to every element between first inclusive and last exclusive.
-    // This is equivalent ot fill(first, last, 0) but may be more efficient.
-    template<class ForwardIterator>
-    inline void zero(ForwardIterator first, ForwardIterator last)
-    {
-        while (first != last) {
-            *first = 0;
-            ++first;
-        }
-    }
-
-
-    // Same as find(first, last, value) but may be more efficient because
-    // it doesn't use a reference for value.
-    template<class InputIterator, class T>
-    inline InputIterator findValue(InputIterator first, InputIterator last, T value)
-    {
-        while (first != last && !(*first == value))
-            ++first;
-        return first;
-    }
-}
-#endif /* algo_h___ */

mozilla/js2/src/bytecodegen.h

@@ -1,396 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef bytecodegen_h___
-#define bytecodegen_h___
-
-#ifdef _WIN32
- // Turn off warnings about identifiers too long in browser information
-#pragma warning(disable: 4786)
-#endif
-
-
-#include <vector>
-#include <map>
-
-#include "systemtypes.h"
-#include "strings.h"
-
-#include "tracer.h"
-
-namespace JavaScript {
-namespace JS2Runtime {
-
-    typedef enum {
-        // 1st 2 bits specify what kind of 'this' exists
-        NoThis = 0x00,
-        Inherent = 0x01,
-        Explicit = 0x02,
-        ThisFlags = 0x03,
-
-        // bit #3 indicates presence of named arguments
-        NamedArguments = 0x04,
-
-        // but #4 is set for the invocation of the super constructor
-        // from inside a constructor
-        SuperInvoke = 0x08
-
-    } CallFlag;
-
-typedef enum {
-
-    LoadConstantUndefinedOp,//                          --> <undefined value object>
-    LoadConstantTrueOp,     //                          --> <true value object>
-    LoadConstantFalseOp,    //                          --> <false value object>
-    LoadConstantNullOp,     //                          --> <null value object>
-    LoadConstantZeroOp,     //                          --> <+0.0 value object>
-    LoadConstantNumberOp,   // <poolindex>              --> <Number value object>
-    LoadConstantStringOp,   // <poolindex>              --> <String value object>
-    LoadThisOp,             //                          --> <this object>      
-    LoadFunctionOp,         // <pointer>        XXX !!! XXX
-    LoadTypeOp,             // <pointer>        XXX !!! XXX
-    InvokeOp,               // <argc> <thisflag>        <function> <args>  --> [<result>]
-    GetTypeOp,              //                          <object> --> <type of object>
-    CastOp,                 //                          <object> <type> --> <object>
-    DoUnaryOp,              // <operation>              <object> --> <result>
-    DoOperatorOp,           // <operation>              <object> <object> --> <result>
-    PushNullOp,             //                          --> <Object(null)>
-    PushIntOp,              // <int>                    --> <Object(int)>
-    PushNumOp,              // <num>                    --> <Object(num)>
-    PushStringOp,           // <poolindex>              --> <Object(index)>
-    PushTypeOp,             // <poolindex>
-    ReturnOp,               //                          <function> <args> <result> --> <result>
-    ReturnVoidOp,           //                          <function> <args> -->
-    GetConstructorOp,       //                          <type> --> <function> 
-    NewObjectOp,            //                          --> <object>
-    NewThisOp,              //                          <type> -->
-    NewInstanceOp,          //  <argc>                  <type> <args> --> <object>
-    DeleteOp,               //  <index>                 <object> --> <boolean>
-    TypeOfOp,               //                          <object> --> <string>
-    InstanceOfOp,           //                          <object> <object> --> <boolean>
-    AsOp,                   //                          <object> <type> --> <object>
-    IsOp,                   //                          <object> <object> --> <boolean>
-    ToBooleanOp,            //                          <object> --> <boolean>
-    JumpFalseOp,            // <target>                 <object> -->
-    JumpTrueOp,             // <target>                 <object> -->
-    JumpOp,                 // <target>            
-    TryOp,                  // <handler> <handler>
-    JsrOp,                  // <target>
-    RtsOp,
-    WithinOp,               //                          <object> -->
-    WithoutOp,              //
-    ThrowOp,                //                          <whatever> <object> --> <object>
-    HandlerOp,
-    LogicalXorOp,           //                          <object> <object> <boolean> <boolean> --> <object> 
-    LogicalNotOp,           //                          <object> --> <object>
-    SwapOp,                 //                          <object1> <object2> --> <object2> <object1>
-    DupOp,                  //                          <object> --> <object> <object>
-    DupInsertOp,            //                          <object1> <object2> --> <object2> <object1> <object2>
-    DupNOp,                 // <N>                      <object> --> <object> { N times }
-    DupInsertNOp,           // <N>                      <object> {xN} <object2> --> <object2> <object> {xN} <object2>
-    PopOp,                  //                          <object> -->   
-    // for instance members
-    GetFieldOp,             // <slot>                   <base> --> <object>
-    SetFieldOp,             // <slot>                   <base> <object> --> <object>
-    // for instance methods
-    GetMethodOp,            // <slot>                   <base> --> <base> <function>
-    GetMethodRefOp,         // <slot>                   <base> --> <bound function> 
-    // for argumentz
-    GetArgOp,               // <index>                  --> <object>
-    SetArgOp,               // <index>                  <object> --> <object>
-    // for local variables in the immediate scope
-    GetLocalVarOp,          // <index>                  --> <object>
-    SetLocalVarOp,          // <index>                  <object> --> <object>
-    // for local variables in the nth closure scope
-    GetClosureVarOp,        // <depth>, <index>         --> <object>
-    SetClosureVarOp,        // <depth>, <index>         <object> --> <object>
-    // for array elements
-    GetElementOp,           //                          <base> <index> --> <object>
-    SetElementOp,           //                          <base> <index> <object> --> <object>
-    // for properties
-    GetPropertyOp,          // <poolindex>              <base> --> <object>
-    GetInvokePropertyOp,    // <poolindex>              <base> --> <base> <object> 
-    SetPropertyOp,          // <poolindex>              <base> <object> --> <object>
-    // for all generic names 
-    GetNameOp,              // <poolindex>              --> <object>
-    GetTypeOfNameOp,        // <poolindex>              --> <object>
-    SetNameOp,              // <poolindex>              <object> --> <object>
-    LoadGlobalObjectOp,     //                          --> <object>
-    PushScopeOp,            // <pointer>        XXX !!! XXX
-    PopScopeOp,             // <pointer>        XXX !!! XXX
-    NewClosureOp,           //                          <function> --> <function>
-    ClassOp,                //                          <object> --> <type>
-    JuxtaposeOp,            //                          <attribute> <attribute> --> <attribute>
-    NamedArgOp,             //                          <object> <string> --> <named arg object>
-
-    OpCodeCount
-
-} ByteCodeOp;
-
-struct ByteCodeData {
-    int8 stackImpact;
-    char *opName;
-};
-extern ByteCodeData gByteCodeData[OpCodeCount];
-
-    typedef std::pair<uint32, size_t> PC_Position;
-
-
-    class ByteCodeModule {
-    public:
-            
-        ByteCodeModule(ByteCodeGen *bcg);
-
-#ifdef DEBUG
-        void* operator new(size_t s)    { void *t = STD::malloc(s); trace_alloc("ByteCodeModule", s, t); return t; }
-        void operator delete(void* t)   { trace_release("ByteCodeModule", t); STD::free(t); }
-#endif
-
-        uint32 getLong(uint32 index) const          { return *((uint32 *)&mCodeBase[index]); }
-        uint16 getShort(uint32 index) const         { return *((uint16 *)&mCodeBase[index]); }
-        int32 getOffset(uint32 index) const         { return *((int32 *)&mCodeBase[index]); }
-        const String *getString(uint32 index) const { return &mStringPoolContents[index]; }
-        float64 getNumber(uint32 index) const       { return mNumberPoolContents[index]; }
-
-        void setSource(const String &source, const String &sourceLocation)
-        {
-            mSource = source;
-            mSourceLocation = sourceLocation;
-        }
-
-        String mSource;
-        String mSourceLocation;
-
-        uint32 mLocalsCount;        // number of local vars to allocate space for
-        uint32 mStackDepth;         // max. depth of execution stack
-        
-        uint8 *mCodeBase;
-        uint32 mLength;
-
-        String *mStringPoolContents;
-        float64 *mNumberPoolContents;
-
-        PC_Position *mCodeMap;
-        uint32 mCodeMapLength;
-
-        size_t getPositionForPC(uint32 pc);
-            
-    };
-    Formatter& operator<<(Formatter& f, const ByteCodeModule& bcm);
-
-    #define BufferIncrement (32)
-
-#define NotALabel ((uint32)(-1))
-
-    class Label {
-    public:
-        
-        typedef enum { InternalLabel, NamedLabel, BreakLabel, ContinueLabel } LabelKind;
-
-        Label() : mKind(InternalLabel), mHasLocation(false) { }
-        Label(LabelStmtNode *lbl) : mKind(NamedLabel), mHasLocation(false), mLabelStmt(lbl) { }
-        Label(LabelKind kind) : mKind(kind), mHasLocation(false) { }
-
-        bool matches(const StringAtom *name)
-        {
-            return ((mKind == NamedLabel) && (mLabelStmt->name.compare(*name) == 0));
-        }
-
-        bool matches(LabelKind kind)
-        {
-            return (mKind == kind);
-        }
-
-        void addFixup(ByteCodeGen *bcg, uint32 branchLocation);        
-        void setLocation(ByteCodeGen *bcg, uint32 location);
-
-        std::vector<uint32> mFixupList;
-
-        LabelKind mKind;
-        bool mHasLocation;
-        LabelStmtNode *mLabelStmt;
-
-        uint32 mLocation;
-    };
-
-    class ByteCodeGen {
-    public:
-
-        ByteCodeGen(Context *cx, ScopeChain *scopeChain) 
-            :   mBuffer(new CodeBuffer), 
-                mScopeChain(scopeChain), 
-                mPC_Map(new CodeMap),
-                m_cx(cx), 
-                mNamespaceList(NULL) ,
-                mStackTop(0),
-                mStackMax(0)
-        { }
-
-#ifdef DEBUG
-        void* operator new(size_t s)    { void *t = STD::malloc(s); trace_alloc("ByteCodeGen", s, t); return t; }
-        void operator delete(void* t)   { trace_release("ByteCodeGen", t); STD::free(t); }
-#endif
-
-        ByteCodeModule *genCodeForScript(StmtNode *p);
-        bool genCodeForStatement(StmtNode *p, ByteCodeGen *static_cg, uint32 finallyLabel);
-        void genCodeForFunction(FunctionDefinition &f, 
-                                    size_t pos,
-                                    JSFunction *fnc, 
-                                    bool isConstructor, 
-                                    JSType *topClass);
-        ByteCodeModule *genCodeForExpression(ExprNode *p);
-
-        JSType *genExpr(ExprNode *p);
-        Reference *genReference(ExprNode *p, Access acc);
-        void genReferencePair(ExprNode *p, Reference *&readRef, Reference *&writeRef);
-
-        typedef std::vector<uint8> CodeBuffer;
-
-        typedef std::vector<PC_Position> CodeMap;
-
-        // this is the current code buffer
-        CodeBuffer *mBuffer;
-        ScopeChain *mScopeChain;
-        CodeMap *mPC_Map;
-
-        Context *m_cx;
-        
-        std::vector<Label> mLabelList;
-        std::vector<uint32> mLabelStack;
-
-        NamespaceList *mNamespaceList;
-
-        int32 mStackTop;        // keep these as signed so as to
-        int32 mStackMax;        // track if they go negative.
-
-        bool hasContent()
-        {
-            return (mBuffer->size() > 0);
-        }
-       
-        void addOp(uint8 op);       // XXX move more outline if it helps to reduce overall .exe size
-
-        void addPosition(size_t pos)    { mPC_Map->push_back(PC_Position(mBuffer->size(), pos)); }
-
-        // Add in the opcode effect as usual, but also stretch the
-        // execution stack by N, as the opcode has that effect during
-        // execution.
-        void addOpStretchStack(uint8 op, int32 n)        
-        {
-            addByte(op);
-            mStackTop += gByteCodeData[op].stackImpact;
-            if ((mStackTop + n) > mStackMax)
-                mStackMax = mStackTop + n;
-            ASSERT(mStackTop >= 0);
-        }
-
-        void adjustStack(int32 n)
-        {
-            mStackTop += n;
-            if ((mStackTop + n) > mStackMax)
-                mStackMax = mStackTop + n;
-            ASSERT(mStackTop >= 0);
-        }
-
-        // Make sure there's room for n more operands on the stack
-        void stretchStack(int32 n)
-        {
-            if ((mStackTop + n) > mStackMax)
-                mStackMax = mStackTop + n;
-        }
-
-        // these routines assume the depth is being reduced
-        // i.e. they don't reset mStackMax
-        void addOpAdjustDepth(uint8 op, int32 depth)        
-                                    { addByte(op); mStackTop += depth; ASSERT(mStackTop >= 0); }
-        void addOpSetDepth(uint8 op, int32 depth)        
-                                    { addByte(op); mStackTop = depth; ASSERT(mStackTop >= 0); }
-
-        void addByte(uint8 v)       { mBuffer->push_back(v); }
-        void addShort(uint16 v)     { mBuffer->push_back((uint8)(v >> 8)); mBuffer->push_back((uint8)(v)); }
-
-        void addPointer(void *v)    { ASSERT(sizeof(void *) == sizeof(uint32)); addLong((uint32)(v)); }   // XXX Pointer size dependant !!!
-        
-        void addLong(uint32 v)     
-            { mBuffer->insert(mBuffer->end(), (uint8 *)&v, (uint8 *)(&v) + sizeof(uint32)); }
-        void addOffset(int32 v)     
-            { mBuffer->insert(mBuffer->end(), (uint8 *)&v, (uint8 *)(&v) + sizeof(int32)); }
-        void setOffset(uint32 index, int32 v)
-            {   *((int32 *)(mBuffer->begin() + index)) = v; }   // XXX
-
-        void addFixup(uint32 label) 
-        { 
-            mLabelList[label].addFixup(this, mBuffer->size()); 
-        }
-
-        uint32 getLabel();
-
-        uint32 getLabel(Label::LabelKind kind);
-
-        uint32 getLabel(LabelStmtNode *lbl);
-
-        uint32 getTopLabel(Label::LabelKind kind, const StringAtom *name);
-
-        uint32 getTopLabel(Label::LabelKind kind);
-
-        void setLabel(uint32 label)
-        {
-            mLabelList[label].setLocation(this, mBuffer->size()); 
-        }
-
-        uint32 currentOffset()
-        {
-            return mBuffer->size();
-        }
-
-        std::vector<String> mStringPoolContents;
-        typedef std::map<String, uint32, std::less<String> > StringPool;
-        StringPool mStringPool;
-
-        std::vector<float64> mNumberPoolContents;
-        typedef std::map<float64, uint32, std::less<double> > NumberPool;
-        NumberPool mNumberPool;
-
-
-        void addNumberRef(float64 f);
-        
-        void addStringRef(const String &str);
-
-
-    };
-
-
-    uint32 printInstruction(Formatter &f, uint32 i, const ByteCodeModule& bcm);
-}
-}
-#endif /* bytecodegen_h___ */

mozilla/js2/src/collector.cpp

@@ -1,240 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s):  Patrick Beard <beard@netscape.com>
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#include "collector.h"
-
-namespace JavaScript
-{
-
-Collector::Collector()
-    :   mObjectSpace(kObjectSpaceSize),
-        mFloatSpace(kFloatSpaceSize)
-{
-}
-
-Collector::~Collector()
-{
-}
-
-void
-Collector::addRoot(void* root, size_type n)
-{
-    mRoots.push_back(RootSegment(pointer(root), n));
-}
-
-void
-Collector::removeRoot(void* root)
-{
-    for (RootSegments::iterator i = mRoots.begin(), e = mRoots.end(); i != e; ++i) {
-        if (i->first == root) {
-            mRoots.erase(i);
-            return;
-        }
-    }
-}
-
-inline Collector::size_type align(Collector::size_type n)
-{
-    return (n + (kObjectAlignment - 1)) & kObjectAddressMask;
-}
-
-Collector::pointer
-Collector::allocateObject(size_type n, pointer type)
-{
-    size_type size = align(n + sizeof(ObjectHeader));
-    pointer ptr = mObjectSpace.mAllocPtr;
-    if ((ptr + size) <= mObjectSpace.mLimitPtr) {
-        mObjectSpace.mAllocPtr += size;
-        ObjectHeader* header = (ObjectHeader*) ptr;
-        header->mSize = size;
-        header->mType = type;
-        return (pointer) std::memset(ptr + sizeof(ObjectHeader), 0, n);
-    }
-    // need to run a garbage collection to recover more space, or double space size?
-    return 0;
-}
-
-float64*
-Collector::allocateFloat64(float64 value)
-{
-    float64* fptr = mFloatSpace.mAllocPtr;
-    if (fptr < mFloatSpace.mLimitPtr) {
-        mFloatSpace.mAllocPtr++;
-        *fptr = value;
-        return (float64*) (uint32(fptr) | kFloat64Tag);
-    }
-    // need to run a garbage collection to recover more space, or double space size?
-    return 0;
-}
-
-inline bool is_object(Collector::pointer ref)
-{
-    return ((uint32(ref) & kObjectAddressMask) == uint32(ref));
-}
-
-inline bool is_float64(Collector::pointer ref)
-{
-    return ((uint32(ref) & kFloat64TagMask) == kFloat64Tag);
-}
-
-void
-Collector::collect()
-{
-    // 0. swap from/to space. we now start allocating in the new toSpace.
-    Space<char>::pointer_type scanPtr = mObjectSpace.Swap();
-    mFloatSpace.Swap();
-
-    // 1. scan all registered root segments.
-    for (RootSegments::iterator i = mRoots.begin(), e = mRoots.end(); i != e; ++i) {
-        RootSegment& r = *i;
-        
-        pointer* refs = (pointer*) r.first;
-        pointer* limit = (pointer*) (r.first + r.second);
-        while (refs < limit) {
-            pointer& ref = *refs++;
-            if (ref) {
-                if (is_object(ref))
-                    ref = copy(ref);
-                else
-                if (is_float64(ref))
-                    ref = copyFloat64(ref);
-            }
-        }
-    }
-    
-    // 2. Scan through toSpace until scanPtr meets mAllocPtr.
-    while (scanPtr < mObjectSpace.mAllocPtr) {
-        ObjectHeader* header = (ObjectHeader*) scanPtr;
-        if (header->mType)
-            header->mType = copy(header->mType);
-        scanPtr += header->mSize;
-        pointer* refs = (pointer*) (header + 1);
-        pointer* limit = (pointer*) scanPtr;
-        while (refs < limit) {
-            pointer& ref = *refs++;
-            if (ref) {
-                if (is_object(ref))
-                    ref = copy(ref);
-                else
-                if (is_float64(ref))
-                    ref = copyFloat64(ref);
-            }
-        }
-    }
-}
-
-Collector::pointer
-Collector::copy(pointer object)
-{
-    // forwarding pointer?
-    ObjectHeader* oldHeader = ((ObjectHeader*)object) - 1;
-    if (oldHeader->mSize == kIsForwardingPointer)
-        return oldHeader->mType;
-
-    // copy the old object into toSpace. copy will always succeed,
-    // because we only call it from within collect. the problem
-    // is when we don't recover any space... will have to be able
-    // to expand the heaps.
-    size_type n = oldHeader->mSize;
-    ObjectHeader* newHeader = (ObjectHeader*) mObjectSpace.mAllocPtr;
-    mObjectSpace.mAllocPtr += n;
-    std::memcpy(newHeader, oldHeader, n);
-    oldHeader->mSize = kIsForwardingPointer;
-    oldHeader->mType = (pointer) (newHeader + 1);
-    
-    return (pointer) (newHeader + 1);
-}
-
-Collector::pointer
-Collector::copyFloat64(pointer object)
-{
-    float64* fptr = mFloatSpace.mAllocPtr++;
-    *fptr = *(float64*) (uint32(object) & kFloat64AddressMask);
-    return (pointer) (uint32(fptr) | kFloat64Tag);
-}
-
-#if DEBUG
-
-struct ConsCell {
-    float64* car;
-    ConsCell* cdr;
-
-    void* operator new(std::size_t n, Collector& gc)
-    {
-        return gc.allocateObject(n);
-    }
-};
-
-void testCollector()
-{
-    Collector gc;
-    
-    ConsCell* head = 0;
-    gc.addRoot(&head, sizeof(ConsCell*));
-    
-    const uint32 kCellCount = 100;
-    
-    ConsCell* cell;
-    ConsCell** link = &head;
-    
-    for (uint32 i = 0; i < kCellCount; ++i) {
-        *link = cell = new (gc) ConsCell;
-        ASSERT(cell);
-        cell->car = gc.allocateFloat64(i);
-        ASSERT(cell->car);
-        link = &cell->cdr;
-    }
-    
-    // circularly link the list.
-    *link = head;
-    
-    // run a garbage collection.
-    gc.collect();
-    
-    // walk the list again to verify that it is intact.
-    link = &head;
-    for (uint32 i = 0; i < kCellCount; i++) {
-        cell = *link;
-        ASSERT(cell->car);
-        float64 value = gc.getFloat64(cell->car);
-        ASSERT(value == (float64)i);
-        link = &cell->cdr;
-    }
-    
-    // make sure list is still circularly linked.
-    ASSERT(*link == head);
-}
-
-#endif // DEBUG
-
-}

mozilla/js2/src/collector.h

@@ -1,156 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s):  Patrick Beard <beard@netscape.com>
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef collector_h___
-#define collector_h___
-
-#include "mem.h"
-#include <deque>
-#include <utility>
-
-namespace JavaScript
-{
-    using std::deque;
-    using std::pair;
-
-    // tuneable parameters of the collector.
-    enum {
-        kLogObjectAlignment = 3,
-        kObjectAlignment = (1 << kLogObjectAlignment),
-        kObjectAddressMask = (-1 << kLogObjectAlignment),
-
-        kFloat64Tag = 0x2,
-        kFloat64TagMask = ~(-1 << 2),
-        kFloat64AddressMask = (-1 << 2),
-
-        kIsForwardingPointer = 0x1,
-
-        kObjectSpaceSize = 1024 * 1024,
-        kFloatSpaceSize = kObjectSpaceSize / sizeof(float64)
-    };
-
-    // collector entry points.
-    class Collector {
-    public:
-        typedef size_t size_type;
-        typedef ptrdiff_t difference_type;
-        typedef char *pointer;
-        typedef const char *const_pointer;
-
-        struct ObjectHeader {
-            size_type mSize;
-            pointer mType;
-        };
-        
-        Collector();
-        ~Collector();
-
-        void addRoot(void* root, size_type n);
-        void removeRoot(void* root);
-
-        pointer allocateObject(size_type n, pointer type = 0);
-        float64* allocateFloat64(float64 value = 0.0);
-        
-        void collect();
-        
-        pointer getType(pointer object)
-        {
-            return ((ObjectHeader*)object)[-1].mType;
-        }
-        
-        size_type getSize(pointer object)
-        {
-            return ((ObjectHeader*)object)[-1].mSize;
-        }
-        
-        float64 getFloat64(float64* fptr)
-        {
-            return *(float64*)(uint32(fptr) & kFloat64AddressMask);
-        }
-        
-    private:
-        template <typename T> struct Space {
-            typedef T value_type;
-            typedef T *pointer_type;
-            size_type mSize;
-            pointer_type mFromPtr;
-            pointer_type mToPtr;
-            pointer_type mAllocPtr;
-            pointer_type mLimitPtr;
-            
-            Space(size_type n)
-                :   mSize(n), mFromPtr(0), mToPtr(0),
-                    mAllocPtr(0), mLimitPtr(0)
-            {
-                mFromPtr = new value_type[n];
-                mToPtr = new value_type[n];
-                mAllocPtr = mToPtr;
-                mLimitPtr = mToPtr + n;
-            }
-            
-            ~Space()
-            {
-                delete[] mFromPtr;
-                delete[] mToPtr;
-            }
-            
-            pointer_type Swap()
-            {
-                pointer_type newToPtr = mFromPtr;
-                pointer_type newFromPtr = mToPtr;
-                mToPtr = newToPtr;
-                mAllocPtr = newToPtr;
-                mLimitPtr = newToPtr + mSize;
-                mFromPtr = newFromPtr;
-                pointer_type scanPtr = newToPtr;
-                return scanPtr;
-            }
-        };
-        Space<char> mObjectSpace;
-        Space<float64> mFloatSpace;
-
-        typedef pair<pointer, size_type> RootSegment;
-        typedef deque<RootSegment> RootSegments;
-        RootSegments mRoots;
-
-        pointer copy(pointer object);
-        pointer copyFloat64(pointer object);
-        
-        Collector(const Collector&);        // No copy constructor
-        void operator=(const Collector&);   // No assignment operator
-    };
-
-    void testCollector();
-}
-
-#endif // collector_h___

mozilla/js2/src/cpucfg.h

@@ -1,191 +0,0 @@
-/* -*- Mode: C; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is Mozilla Communicator client code, released
- * March 31, 1998.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef cpucfg_h
-#define cpucfg_h
-
-#define JS_HAVE_LONG_LONG
-
-#ifdef XP_MAC
-#undef  IS_LITTLE_ENDIAN
-#define IS_BIG_ENDIAN 1
-
-#define JS_BYTES_PER_BYTE   1L
-#define JS_BYTES_PER_SHORT  2L
-#define JS_BYTES_PER_INT    4L
-#define JS_BYTES_PER_INT64  8L
-#define JS_BYTES_PER_LONG   4L
-#define JS_BYTES_PER_FLOAT  4L
-#define JS_BYTES_PER_DOUBLE 8L
-#define JS_BYTES_PER_WORD   4L
-#define JS_BYTES_PER_DWORD  8L
-
-#define JS_BITS_PER_BYTE    8L
-#define JS_BITS_PER_SHORT   16L
-#define JS_BITS_PER_INT     32L
-#define JS_BITS_PER_INT64   64L
-#define JS_BITS_PER_LONG    32L
-#define JS_BITS_PER_FLOAT   32L
-#define JS_BITS_PER_DOUBLE  64L
-#define JS_BITS_PER_WORD    32L
-
-#define JS_BITS_PER_BYTE_LOG2   3L
-#define JS_BITS_PER_SHORT_LOG2  4L
-#define JS_BITS_PER_INT_LOG2    5L
-#define JS_BITS_PER_INT64_LOG2  6L
-#define JS_BITS_PER_LONG_LOG2   5L
-#define JS_BITS_PER_FLOAT_LOG2  5L
-#define JS_BITS_PER_DOUBLE_LOG2 6L
-#define JS_BITS_PER_WORD_LOG2   5L
-
-#define JS_ALIGN_OF_SHORT   2L
-#define JS_ALIGN_OF_INT     4L
-#define JS_ALIGN_OF_LONG    4L
-#define JS_ALIGN_OF_INT64   2L
-#define JS_ALIGN_OF_FLOAT   4L
-#define JS_ALIGN_OF_DOUBLE  4L
-#define JS_ALIGN_OF_POINTER 4L
-#define JS_ALIGN_OF_WORD    4L
-
-#define JS_BYTES_PER_WORD_LOG2   2L
-#define JS_BYTES_PER_DWORD_LOG2  3L
-#define PR_WORDS_PER_DWORD_LOG2  1L
-
-#elif defined(XP_PC)
-
-#ifdef _WIN32
-#define IS_LITTLE_ENDIAN 1
-#undef  IS_BIG_ENDIAN
-
-#define JS_BYTES_PER_BYTE   1L
-#define JS_BYTES_PER_SHORT  2L
-#define JS_BYTES_PER_INT    4L
-#define JS_BYTES_PER_INT64  8L
-#define JS_BYTES_PER_LONG   4L
-#define JS_BYTES_PER_FLOAT  4L
-#define JS_BYTES_PER_DOUBLE 8L
-#define JS_BYTES_PER_WORD   4L
-#define JS_BYTES_PER_DWORD  8L
-
-#define JS_BITS_PER_BYTE    8L
-#define JS_BITS_PER_SHORT   16L
-#define JS_BITS_PER_INT     32L
-#define JS_BITS_PER_INT64   64L
-#define JS_BITS_PER_LONG    32L
-#define JS_BITS_PER_FLOAT   32L
-#define JS_BITS_PER_DOUBLE  64L
-#define JS_BITS_PER_WORD    32L
-
-#define JS_BITS_PER_BYTE_LOG2   3L
-#define JS_BITS_PER_SHORT_LOG2  4L
-#define JS_BITS_PER_INT_LOG2    5L
-#define JS_BITS_PER_INT64_LOG2  6L
-#define JS_BITS_PER_LONG_LOG2   5L
-#define JS_BITS_PER_FLOAT_LOG2  5L
-#define JS_BITS_PER_DOUBLE_LOG2 6L
-#define JS_BITS_PER_WORD_LOG2   5L
-
-#define JS_ALIGN_OF_SHORT   2L
-#define JS_ALIGN_OF_INT     4L
-#define JS_ALIGN_OF_LONG    4L
-#define JS_ALIGN_OF_INT64   8L
-#define JS_ALIGN_OF_FLOAT   4L
-#define JS_ALIGN_OF_DOUBLE  4L
-#define JS_ALIGN_OF_POINTER 4L
-#define JS_ALIGN_OF_WORD    4L
-
-#define JS_BYTES_PER_WORD_LOG2   2L
-#define JS_BYTES_PER_DWORD_LOG2  3L
-#define PR_WORDS_PER_DWORD_LOG2  1L
-#endif /* _WIN32 */
-
-#if defined(_WINDOWS) && !defined(_WIN32) /* WIN16 */
-#define IS_LITTLE_ENDIAN 1
-#undef  IS_BIG_ENDIAN
-
-#define JS_BYTES_PER_BYTE   1L
-#define JS_BYTES_PER_SHORT  2L
-#define JS_BYTES_PER_INT    2L
-#define JS_BYTES_PER_INT64  8L
-#define JS_BYTES_PER_LONG   4L
-#define JS_BYTES_PER_FLOAT  4L
-#define JS_BYTES_PER_DOUBLE 8L
-#define JS_BYTES_PER_WORD   4L
-#define JS_BYTES_PER_DWORD  8L
-
-#define JS_BITS_PER_BYTE    8L
-#define JS_BITS_PER_SHORT   16L
-#define JS_BITS_PER_INT     16L
-#define JS_BITS_PER_INT64   64L
-#define JS_BITS_PER_LONG    32L
-#define JS_BITS_PER_FLOAT   32L
-#define JS_BITS_PER_DOUBLE  64L
-#define JS_BITS_PER_WORD    32L
-
-#define JS_BITS_PER_BYTE_LOG2   3L
-#define JS_BITS_PER_SHORT_LOG2  4L
-#define JS_BITS_PER_INT_LOG2    4L
-#define JS_BITS_PER_INT64_LOG2  6L
-#define JS_BITS_PER_LONG_LOG2   5L
-#define JS_BITS_PER_FLOAT_LOG2  5L
-#define JS_BITS_PER_DOUBLE_LOG2 6L
-#define JS_BITS_PER_WORD_LOG2   5L
-
-#define JS_ALIGN_OF_SHORT   2L
-#define JS_ALIGN_OF_INT     2L
-#define JS_ALIGN_OF_LONG    2L
-#define JS_ALIGN_OF_INT64   2L
-#define JS_ALIGN_OF_FLOAT   2L
-#define JS_ALIGN_OF_DOUBLE  2L
-#define JS_ALIGN_OF_POINTER 2L
-#define JS_ALIGN_OF_WORD    2L
-
-#define JS_BYTES_PER_WORD_LOG2   2L
-#define JS_BYTES_PER_DWORD_LOG2  3L
-#define PR_WORDS_PER_DWORD_LOG2  1L
-#endif /* defined(_WINDOWS) && !defined(_WIN32) */
-
-#elif defined(XP_UNIX) || defined(XP_BEOS)
-
-#error "This file is supposed to be auto-generated on UNIX platforms, but the"
-#error "static version for Mac and Windows platforms is being used."
-#error "Something's probably wrong with paths/headers/dependencies/Makefiles."
-
-#else
-
-#error "Must define one of XP_MAC, XP_PC, or XP_UNIX"
-
-#endif
-
-#endif

mozilla/js2/src/debugger.cpp

@@ -1,472 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifdef _WIN32
- // Turn off warnings about identifiers too long in browser information
- #pragma warning(disable: 4786)
-#endif
-
-#include "world.h"
-#include "utilities.h"
-#include "debugger.h"
-
-#include <string>
-#include <ctype.h>
-#include <assert.h>
-
-namespace JavaScript {
-namespace Debugger {
-
-    using namespace Interpreter;
-
-    /* keep in sync with list in debugger.h */
-    static const char *shell_cmds[][3] = {
-        {"assemble", "", 0},
-        {"ambiguous", "", "Test command for ambiguous command detection"},
-        {"ambiguous2", "", "Test command for ambiguous command detection"},
-        {"continue", "", "Continue execution until complete."},
-        {"dissassemble", "[start_pc] [end_pc]", "Dissassemble entire module, or subset of module."},
-        {"exit", "", 0},
-        {"help", "", "Display this message."},
-        {"istep", "", "Execute the current opcode and stop."},
-        {"let", "", "Set a debugger environment variable."},
-        {"print", "", 0},
-        {"register", "", "(nyi) Show the value of a single register or all registers, or set the value of a single register."},
-        {"step", "", "Execute the current JS statement and stop."},
-        {0, 0} /* sentry */
-    };
-
-    enum ShellVariable {
-        TRACE_SOURCE,
-        TRACE_ICODE,
-        VARIABLE_COUNT
-    };
-    
-    static const char *shell_vars[][3] = {
-        {"tracesource", "", "(bool) Show JS source while executing."},
-        {"traceicode", " ", "(bool) Show opcodes while executing."},
-        {0, 0} /* sentry */
-    };
-    
-    /* return true if str2 starts with/is str1
-     * XXX ignore case */
-    static bool
-    startsWith (const String &str1, const String &str2)
-    {
-        uint n;
-        size_t m = str1.size();
-
-        if (m > str2.size())
-            return false;
-
-        for (n = 0; n < m; ++n)
-            if (str1[n] != str2[n])
-                return false;
-        
-        return true;
-    }
-
-
-    /**
-     * locate the best match for |partial| in the command list |list|.
-     * if no matches are found, return |length|, if multiple matches are found,
-     * return |length| plus the number of ambiguous matches
-     */
-    static uint32
-    matchElement (const String &partial, const char *list[][3], size_t length)
-    {
-        uint32 ambig_matches = 0;
-        uint32 match = length;
-        
-        for (uint32 i = 0; i < length ; ++i)
-        {
-            String possibleMatch (widenCString(list[i][0]));
-            if (startsWith(partial, possibleMatch))
-            {
-                if (partial.size() == possibleMatch.size())
-                {
-                    /* exact match */
-                    ambig_matches = 0;
-                    return i;
-                }
-                else if (match == COMMAND_COUNT) /* no match yet */
-                    match = i;
-                else
-                    ++ambig_matches; /* something already matched, 
-                                      * ambiguous command */
-            }
-            
-        }
-
-        if (ambig_matches == 0)
-            return match;
-        else
-            return length + ambig_matches;
-        
-    }    
-
-    static void
-    showHelp(Formatter &out)
-    {
-        int i;
-        
-        out << "JavaScript 2.0 Debugger Help...\n\n";
-        
-        for (i = 0; shell_cmds[i][0] != 0; i++)
-        {
-            out << "Command : " << shell_cmds[i][0] << " " << 
-                shell_cmds[i][1] << "\n";
-
-            if (shell_cmds[i][2])
-                out << "Help    : " << shell_cmds[i][2] << "\n";
-            else
-                out << "Help    : (probably) Not Implemented.\n";
-        }
-    }
-
-    static uint32
-    getClosestSourcePosForPC (Context *cx, InstructionIterator pc)
-    {
-        ICodeModule *iCode = cx->getICode();
-        
-        if (iCode->mInstructionMap->begin() == iCode->mInstructionMap->end())
-            return NotABanana;
-            /*NOT_REACHED ("Instruction map is empty, waah.");*/
-
-        InstructionMap::iterator pos_iter =
-            iCode->mInstructionMap->upper_bound (static_cast<uint32>(pc - iCode->its_iCode->begin()));
-        if (pos_iter != iCode->mInstructionMap->begin())
-            --pos_iter;
-    
-        return pos_iter->second;
-    }
-        
-    void
-    Shell::showSourceAtPC (Context *cx, InstructionIterator pc)
-    {
-        if (!mResolveFileCallback)
-        {
-            mErr << "Source not available (Debugger was improperly initialized.)\n";
-            return;
-        }
-
-        ICodeModule *iCode = cx->getICode();
-
-        String fn = iCode->getFileName();
-        const Reader *reader = mResolveFileCallback(fn);
-        if (!reader)
-        {
-            mErr << "Source not available.\n";
-            return;
-        }
-        
-        uint32 pos = getClosestSourcePosForPC(cx, pc);
-        if (pos == NotABanana)
-        {
-            mErr << "Map is empty, cannot display source.\n";
-            return;
-        }
-            
-        uint32 lineNum = reader->posToLineNum (pos);
-        const char16 *lineBegin, *lineEnd;
-
-        uint32 lineStartPos = reader->getLine (lineNum, lineBegin, lineEnd);
-        String sourceLine (lineBegin, lineEnd);
-        
-        mOut << fn << ":" << lineNum << " " << sourceLine << "\n";
-
-        uint padding = fn.length() + (uint32)(lineNum / 10) + 3;
-        uint i;        
-
-        for (i = 0; i < padding; i++)
-            mOut << " ";
-        
-        padding = (pos - lineStartPos);
-        for (i = 0; i < padding; i++)
-            mOut << ".";
-        
-        mOut << "^\n";
-        
-    }
-
-    void
-    Shell::showOpAtPC(Context* cx, InstructionIterator pc)
-    {
-        ICodeModule *iCode = cx->getICode();
-
-        if ((pc < iCode->its_iCode->begin()) ||
-            (pc >= iCode->its_iCode->end()))
-        {
-            mErr << "PC Out Of Range.";
-            return;
-        }
-
-        JSValues &registers = cx->getRegisters();
-
-        printFormat(mOut, "trace [%02u:%04u]: ",
-                    iCode->mID, (pc - iCode->its_iCode->begin()));
-        Instruction* i = *pc;
-        stdOut << *i;
-        if (i->op() != BRANCH && i->count() > 0) {
-            mOut << " [";
-            i->printOperands(stdOut, registers);
-            mOut << "]\n";
-        } else {
-            mOut << '\n';
-        }
-    }    
-
-    void
-    Shell::listen(Context* cx, Context::Event event)
-    {
-        InstructionIterator pc = cx->getPC();
-        
-        if (mTraceSource)
-            showSourceAtPC (cx, pc);
-        if (mTraceICode)
-            showOpAtPC (cx, pc);
-            
-        if (!(mStopMask & event))
-            return;
-
-        if ((mLastCommand == STEP) && (mLastICodeID == cx->getICode()->mID) &&
-            (mLastSourcePos == getClosestSourcePosForPC (cx, cx->getPC())))
-            /* we're in source-step mode, and the source position hasn't
-             * changed yet */
-            return;
-
-        if (!mTraceSource && !mTraceICode)
-            showSourceAtPC (cx, pc);
-                
-        static String lastLine(widenCString("help\n"));
-        String line;
-        LineReader reader(mIn);
-
-        do {
-            stdOut << "jsd";
-            if (mLastCommand != COMMAND_COUNT)
-                stdOut << " (" << shell_cmds[mLastCommand][0] << ") ";
-            stdOut << "> ";
-        
-            reader.readLine(line);
-
-            if (line[0] == uni::lf)
-                line = lastLine;
-            else
-                lastLine = line;
-
-        } while (doCommand(cx, line));
-    }
-
-
-    /**
-     * lex and execute the debugger command in |source|, return true if the
-     * command does not require the script being debugged to continue (eg, ask
-     * for more debugger input.)
-     */
-    bool
-    Shell::doCommand (Interpreter::Context *cx, const String &source)
-    {
-        Lexer lex (mWorld, source, widenCString("debugger console"), 0);
-        const String *cmd;
-        uint32 match;
-        bool rv = true;
-        
-        const Token &t = lex.get(true);
-
-        if (t.hasKind(Token::identifier))
-            cmd = &(t.getIdentifier());
-        else
-        {
-            mErr << "you idiot.\n";
-            return true;
-        }        
-
-        match = matchElement (*cmd, shell_cmds, (size_t)COMMAND_COUNT);
-        
-        if (match <= (uint32)COMMAND_COUNT)
-        {
-            switch ((ShellCommand)match)
-            {
-                case COMMAND_COUNT:
-                    mErr << "Unknown command '" << *cmd << "'.\n";
-                    break;
-
-                case AMBIGUOUS:
-                case AMBIGUOUS2:
-                    mErr << "I pity the foogoo.\n";
-                    break;
-
-                case CONTINUE:
-                    mStopMask &= (Context::EV_ALL ^ Context::EV_STEP);
-                    rv = false;
-                    break;
-
-                case DISSASSEMBLE:
-                    mOut << *cx->getICode();
-                    break;    
-
-                case HELP:
-                    showHelp (mOut);
-                    break;
-
-                case PRINT:
-                    doPrint (cx, lex);
-                    break;
-                    
-                case STEP:
-                    mStopMask |= Context::EV_STEP;
-                    rv = false;
-                    break;
-                    
-                case LET:
-                    doSetVariable (lex);
-                    break;
-
-                default:
-                    mErr << "Input '" << *cmd << "' matched unimplemented " <<
-                        "command '" << shell_cmds[match][0] << "'.\n";
-                    break;
-                    
-            }
-
-            mLastSourcePos = getClosestSourcePosForPC (cx, cx->getPC());
-            mLastICodeID = cx->getICode()->mID;
-            mLastCommand = (ShellCommand)match;
-
-        } else
-            mErr << "Ambiguous command '" << *cmd << "', " <<
-                (match - (uint32)COMMAND_COUNT + 1) << " similar commands.\n";
-
-        return rv;        
-    }
-
-    void
-    Shell::doSetVariable (Lexer &lex)
-    {
-        uint32 match;
-        const String *varname;        
-        const Token *t = &(lex.get(true));
-
-        if (t->hasKind(Token::identifier))
-            varname = &(t->getIdentifier());
-        else
-        {
-            mErr << "invalid variable name.\n";
-            return;
-        }        
-
-        match = matchElement (*varname, shell_vars, (size_t)VARIABLE_COUNT);
-
-        if (match <= (uint32)VARIABLE_COUNT)
-            switch ((ShellVariable)match)
-            {
-                case VARIABLE_COUNT:
-                    mErr << "Unknown variable '" << *varname << "'.\n";
-                    break;
-                    
-                case TRACE_SOURCE:
-                    t = &(lex.get(true));
-                    if (t->hasKind(Token::assignment))
-                        t = &(lex.get(true)); /* optional = */
-
-                    if (t->hasKind(Token::True))
-                        mTraceSource = true;
-                    else if (t->hasKind(Token::False))
-                        mTraceSource = false;
-                    else
-                        goto badval;
-                    break;
-
-                case TRACE_ICODE:
-                    t = &(lex.get(true));
-                    if (t->hasKind(Token::assignment))
-                        t = &(lex.get(true)); /* optional = */
-
-                    if (t->hasKind(Token::True))
-                        mTraceICode = true;
-                    else if (t->hasKind(Token::False))
-                        mTraceICode = false;
-                    else
-                        goto badval;
-                    break;
-
-                default:
-                    mErr << "Variable '" << *varname <<
-                        "' matched unimplemented variable '" << 
-                        shell_vars[match][0] << "'.\n";
-            }
-        else
-            mErr << "Ambiguous variable '" << *varname << "', " <<
-                (match - (uint32)COMMAND_COUNT + 1) << " similar variables.\n";
-        
-        return;
-        
-    badval:
-        mErr << "Invalid value for variable '" <<
-            shell_vars[(ShellVariable)match][0] << "'\n";
-
-    }
-    
-    void
-    Shell::doPrint (Context *, Lexer &lex)
-    {
-        const Token *t = &(lex.get(true));
-
-        if (!(t->hasKind(Token::identifier)))
-        {
-            mErr << "Invalid register name.\n";
-            return;
-        }
-
-/*
-        const StringAtom *name = &(t->getIdentifier());
-        
-        VariableMap::iterator i = ((cx->getICode())->itsVariables)->find(*name);
-//        if (i)
-            mOut << (*i).first << " = " << (*i).second << "\n";
-//        else
-//            mOut << "No " << *name << " defined.\n";
-  
-*/      
-    }
-    
-            
-            
-    
-} /* namespace Debugger */
-} /* namespace JavaScript */
-
-                    
-            
-        

mozilla/js2/src/debugger.h

@@ -1,163 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-/* this is all vapor, don't take it to serious yet */
-
-#ifndef debugger_h
-#define debugger_h
-
-#include "utilities.h"
-#include "interpreter.h"
-
-#include <stdio.h>
-
-namespace JavaScript {
-namespace Debugger {
-
-    using namespace Interpreter;
-
-    class Shell;
-    
-    typedef const Reader *ResolveFileCallback (const String &fileName);
-    typedef bool DebuggerCommandCallback (Shell &debugger, const Lexer &lex);
-
-    class Breakpoint {
-    public:
-        /* representation of a breakpoint */
-        void set();
-        void clear();
-        bool getState();
-        InstructionIterator getPC();
-    };    
-
-    struct DebuggerCommand
-    {
-        DebuggerCommand(String aName, String aParamDesc, String aShortHelp,
-                        String aLongHelp = widenCString("No more help available."),
-                        DebuggerCommandCallback *aCommandFunction = 0) 
-            : mName(aName), mParamDesc(aParamDesc), mShortHelp(aShortHelp),
-              mLongHelp(aLongHelp), mCommandFunction(aCommandFunction) {}
-
-        String mName;
-        String mParamDesc;
-        String mShortHelp;
-        String mLongHelp;
-        DebuggerCommandCallback *mCommandFunction;
-    };
-
-    /* keep in sync with list in debugger.cpp */
-    enum ShellCommand {
-        ASSEMBLE,
-        AMBIGUOUS,
-        AMBIGUOUS2,
-        CONTINUE,
-        DISSASSEMBLE,
-        EXIT,
-        HELP,
-        ISTEP,
-        LET,
-        PRINT,
-        REGISTER,
-        STEP,
-        COMMAND_COUNT
-    };
-        
-    class Shell : public Context::Listener {
-    public:        
-        Shell (World &aWorld, FILE *aIn, Formatter &aOut, Formatter &aErr,
-               ResolveFileCallback *aCallback = 0) :
-            mWorld(aWorld), mIn(aIn), mOut(aOut), mErr(aErr),
-            mResolveFileCallback(aCallback), mStopMask(Context::EV_DEBUG),
-            mTraceSource(false), mTraceICode(false), mLastSourcePos(0),
-            mLastICodeID(NotABanana), mLastCommand(COMMAND_COUNT)
-        {
-        }
-
-        ~Shell ()
-        {
-        }
-        
-        ResolveFileCallback
-            *setResolveFileCallback (ResolveFileCallback  *aCallback)
-        {
-            ResolveFileCallback *rv = mResolveFileCallback;
-            mResolveFileCallback = aCallback;
-            return rv;
-        }
-        
-        void listen(Context *context, Context::Event event);
-        
-        /**
-         * install on a context
-         */
-        bool attachToContext (Context *aContext)
-        {
-            aContext->addListener (this);
-            return true;
-        }
-        
-        /**
-         * detach an icdebugger from a context
-         */
-        bool detachFromContext (Context *aContext)
-        {
-            aContext->removeListener (this);
-            return true;
-        }
-
-        FILE *getIStream() { return mIn; }
-        Formatter &getOStream() { return mOut; }
-        Formatter &getEStream() { return mErr; }
-
-    private:
-        bool doCommand (Context *cx, const String &aSource);
-        void doSetVariable (Lexer &lex);
-        void doPrint (Context *cx, Lexer &lex);
-
-        void showOpAtPC(Context* cx, InstructionIterator pc);
-        void showSourceAtPC(Context* cx, InstructionIterator pc);
-        
-        World &mWorld;
-        FILE *mIn;
-        Formatter &mOut, &mErr;
-        ResolveFileCallback *mResolveFileCallback;
-        uint32 mStopMask;
-        bool mTraceSource, mTraceICode;
-        uint32 mLastSourcePos, mLastICodeID;
-        ShellCommand mLastCommand;
-    };    
-
-} /* namespace Debugger */
-} /* namespace JavaScript */
-
-#endif /* debugger_h */

mozilla/js2/src/ds.h

@@ -1,740 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef ds_h___
-#define ds_h___
-
-#include <memory>
-
-#include "utilities.h"
-
-namespace JavaScript 
-{
-
-//
-// Save-Restore Pattern
-//
-
-    // Use the definition
-    //   SaveRestore<T> temp(var)
-    // to save the current value of var at the time of the definition into a temporary temp
-    // and restore var to the saved value at the end of temp's scope, regardless of whether
-    // temp goes out of scope due to normal execution or due to a thrown exception.
-    template<typename T> class SaveRestore {
-        const T savedValue;
-        T &var;
-
-      public:
-        SaveRestore(T &t): savedValue(t), var(t) {}
-        ~SaveRestore() {var = savedValue;}
-    };
-
-
-//
-// Doubly Linked Lists
-//
-
-    // A ListQueue provides insert and delete operations on a doubly-linked list of
-    // objects threaded through fields named 'next' and 'prev'.  The type parameter
-    // E must be a class derived from ListQueueEntry.
-    // The ListQueue does not own its elements.  They must be deleted explicitly if
-    // needed.
-    struct ListQueueEntry {
-        ListQueueEntry *next;                   // Next entry in linked list
-        ListQueueEntry *prev;                   // Previous entry in linked list
-        
-#ifdef DEBUG
-        ListQueueEntry(): next(0), prev(0) {}
-#endif
-    };
-    
-    template <class E>
-    struct ListQueue: private ListQueueEntry {
-        
-        ListQueue() {next = this; prev = this;}
-        
-        // Return true if the ListQueue is nonempty.
-        operator bool() const {return next != static_cast<const ListQueueEntry *>(this);}
-
-        // Return true if the ListQueue is empty.
-        bool operator !() const {return next == static_cast<const ListQueueEntry *>(this);}
-
-        E &front() const {ASSERT(operator bool()); return *static_cast<E *>(next);}
-        E &back() const {ASSERT(operator bool()); return *static_cast<E *>(prev);}
-
-        void push_front(E &elt) {
-            ASSERT(!elt.next && !elt.prev);
-            elt.next = next; elt.prev = this; next->prev = &elt; next = &elt;
-        }
-        
-        void push_back(E &elt) {
-            ASSERT(!elt.next && !elt.prev);
-            elt.next = this; elt.prev = prev; prev->next = &elt; prev = &elt;
-        }
-
-        E &pop_front() {
-            ASSERT(operator bool());
-            E *elt = static_cast<E *>(next); next = elt->next; next->prev = this;
-            DEBUG_ONLY(elt->next = 0; elt->prev = 0;) return *elt;
-        }
-        
-        E &pop_back() {
-            ASSERT(operator bool());
-            E *elt = static_cast<E *>(prev); prev = elt->prev; prev->next = this;
-            DEBUG_ONLY(elt->next = 0; elt->prev = 0;);
-            return *elt;
-        }
-    };
-
-
-//
-// Growable Arrays
-//
-
-    // A Buffer initially points to inline storage of initialSize elements of type T.
-    // The Buffer can be expanded via the expand method to increase its size by
-    // allocating storage from the heap.
-    template <typename T, size_t initialSize> class Buffer {
-      public:
-        T *buffer;                      // Pointer to the current buffer
-        size_t size;                    // Current size of the buffer
-      private:
-        T initialBuffer[initialSize];   // Initial buffer
-      public:
-        Buffer(): buffer(initialBuffer), size(initialSize) {}
-        ~Buffer() {if (buffer != initialBuffer) delete[] buffer;}
-        
-        void expand(size_t newSize);
-    };
-
-
-    // Expand the buffer to size newSize, which must be greater than the current
-    // size. The buffer's contents are not preserved.
-    template <typename T, size_t initialSize>
-    inline void Buffer<T, initialSize>::expand(size_t newSize) {
-        ASSERT(newSize > size);
-        if (buffer != initialBuffer) {
-            delete[] buffer;
-            buffer = 0;     // For exception safety if the allocation below fails.
-        }
-        buffer = new T[newSize];
-        size = newSize;
-    }
-
-
-    // See ArrayBuffer below.
-    template <typename T> class RawArrayBuffer {
-        T *const cache;                 // Pointer to a fixed-size cache for holding the buffer if it's small enough
-      protected:
-        T *buffer;                      // Pointer to the current buffer
-        size_t length;                  // Logical size of the buffer
-        size_t bufferSize;              // Physical size of the buffer
-#ifdef DEBUG
-        size_t maxReservedSize;         // Maximum size reserved so far
-#endif
-
-      public:
-        RawArrayBuffer(T *cache, size_t cacheSize) :
-            cache(cache), buffer(cache), length(0), bufferSize(cacheSize) {
-            DEBUG_ONLY(maxReservedSize = 0);
-        }
-      private:
-        RawArrayBuffer(const RawArrayBuffer&);      // No copy constructor
-        void operator=(const RawArrayBuffer&);      // No assignment operator
-      public:
-        ~RawArrayBuffer() {if (buffer != cache) delete[] buffer;}
-        
-      private:
-        void enlarge(size_t newLength);
-      public:
-        // Methods that do not expand the buffer cannot throw exceptions.
-        size_t size() const {return length;}
-        operator bool() const {return length != 0;}
-        bool operator !() const {return length == 0;}
-        
-        T &front() {ASSERT(length); return *buffer;}
-        const T &front() const {ASSERT(length); return *buffer;}
-        T &back() {ASSERT(length); return buffer[length-1];}
-        const T &back() const {ASSERT(length); return buffer[length-1];}
-        T *contents() const {return buffer;}
-        
-        void reserve(size_t nElts);
-        T *reserve_back(size_t nElts = 1);
-        T *advance_back(size_t nElts = 1);
-        T *reserve_advance_back(size_t nElts = 1);
-        
-        void fast_push_back(const T &elt);
-        void push_back(const T &elt);
-        void append(const T *elts, size_t nElts);
-        void append(const T *begin, const T *end) {ASSERT(end >= begin); append(begin, toSize_t(end - begin));}
-        
-        T &pop_back() {ASSERT(length); return buffer[--length];}
-    };
-
-
-    // Enlarge the buffer so that it can hold at least newLength elements.
-    // May throw an exception, in which case the buffer is left unchanged.
-    template <typename T>
-    void RawArrayBuffer<T>::enlarge(size_t newLength) {
-        size_t newBufferSize = bufferSize * 2;
-        if (newBufferSize < newLength)
-            newBufferSize = newLength;
-        
-        auto_ptr<T> newBuffer(new T[newBufferSize]);
-        T *oldBuffer = buffer;
-        std::copy(oldBuffer, oldBuffer + length, newBuffer.get());
-        buffer = newBuffer.release();
-        if (oldBuffer != cache)
-            delete[] oldBuffer;
-        bufferSize = newBufferSize;
-    }
-
-    // Ensure that there is room to hold nElts elements in the buffer, without
-    // expanding the buffer's logical length.
-    // May throw an exception, in which case the buffer is left unchanged.
-    template <typename T>
-    inline void RawArrayBuffer<T>::reserve(size_t nElts) {
-        if (bufferSize < nElts)
-            enlarge(nElts);
-#ifdef DEBUG
-        if (maxReservedSize < nElts)
-            maxReservedSize = nElts;
-#endif
-    }
-
-    // Ensure that there is room to hold nElts more elements in the buffer, without
-    // expanding the buffer's logical length.  Return a pointer to the first element
-    // just past the logical length.
-    // May throw an exception, in which case the buffer is left unchanged.
-    template <typename T>
-    inline T *RawArrayBuffer<T>::reserve_back(size_t nElts) {
-        reserve(length + nElts);
-        return buffer[length];
-    }
-
-    // Advance the logical length by nElts, assuming that the memory has previously
-    // been reserved.
-    // Return a pointer to the first new element.
-    template <typename T>
-    inline T *RawArrayBuffer<T>::advance_back(size_t nElts) {
-        ASSERT(length + nElts <= maxReservedSize);
-        T *p = buffer + length;
-        length += nElts;
-        return p;
-    }
-
-    // Combine the effects of reserve_back and advance_back.
-    template <typename T>
-    inline T *RawArrayBuffer<T>::reserve_advance_back(size_t nElts) {
-        reserve(length + nElts);
-        T *p = buffer + length;
-        length += nElts;
-        return p;
-    }
-
-    // Same as push_back but assumes that the memory has previously been reserved.
-    // May throw an exception if copying elt throws one, in which case the buffer is
-    // left unchanged.
-    template <typename T>
-    inline void RawArrayBuffer<T>::fast_push_back(const T &elt) {
-        ASSERT(length < maxReservedSize);
-        buffer[length] = elt;
-        ++length;
-    }
-
-    // Append elt to the back of the buffer.
-    // May throw an exception, in which case the buffer is left unchanged.
-    template <typename T>
-    inline void RawArrayBuffer<T>::push_back(const T &elt) {
-        *reserve_back() = elt;
-        ++length;
-    }
-
-    // Append nElts elements elts to the back of the array buffer.
-    // May throw an exception, in which case the buffer is left unchanged.
-    template <typename T>
-    void RawArrayBuffer<T>::append(const T *elts, size_t nElts) {
-        size_t newLength = length + nElts;
-        if (newLength > bufferSize)
-            enlarge(newLength);
-        std::copy(elts, elts + nElts, buffer + length);
-        length = newLength;
-    }
-
-
-    // An ArrayBuffer represents an array of elements of type T.  The ArrayBuffer
-    // contains storage for a fixed size array of cacheSize elements; if this size
-    // is exceeded, the ArrayBuffer allocates the array from the heap.  Elements can
-    // be appended to the back of the array using append.  An ArrayBuffer can also
-    // act as a stack: elements can be pushed and popped from the back.
-    //
-    // All ArrayBuffer operations are atomic with respect to exceptions -- either
-    // they succeed or they do not affect the ArrayBuffer's existing elements and
-    // length. If T has a constructor, it must have a constructor with no arguments;
-    // that constructor is called at the time memory for the ArrayBuffer is
-    // allocated, just like when allocating a regular C++ array.
-    template <typename T, size_t cacheSize>
-    class ArrayBuffer: public RawArrayBuffer<T> {
-        T cacheArray[cacheSize];
-      public:
-        ArrayBuffer(): RawArrayBuffer<T>(cacheArray, cacheSize) {}
-    };
-
-
-//
-// Bit Sets
-//
-
-    template<size_t size> class BitSet {
-        STATIC_CONST(size_t, nWords = (size+31)>>5);
-        STATIC_CONST(uint32, lastWordMask = (2u<<((size-1)&31)) - 1);
-
-        uint32 words[nWords];   // Bitmap; the first word contains bits 0(LSB)...31(MSB), the second contains bits 32...63, etc.
-
-      public:
-        void clear() {zero(words, words+nWords);}
-        BitSet() {clear();}
-
-        // Construct a BitSet out of an array of alternating low (inclusive)
-        // and high (exclusive) ends of ranges of set bits.
-        // The array is terminated by a 0,0 range.
-        template<typename In> explicit BitSet(In a) {
-            clear();
-            size_t low, high;
-            while (low = *a++, (high = *a++) != 0) setRange(low, high);
-        }
-                
-        bool operator[](size_t i) const {ASSERT(i < size); return static_cast<bool>(words[i>>5]>>(i&31) & 1);}
-        bool none() const;
-        bool operator==(const BitSet &s) const;
-        bool operator!=(const BitSet &s) const;
-        
-        void set(size_t i) {ASSERT(i < size); words[i>>5] |= 1u<<(i&31);}
-        void reset(size_t i) {ASSERT(i < size); words[i>>5] &= ~(1u<<(i&31));}
-        void flip(size_t i) {ASSERT(i < size); words[i>>5] ^= 1u<<(i&31);}
-        void setRange(size_t low, size_t high);
-        void resetRange(size_t low, size_t high);
-        void flipRange(size_t low, size_t high);
-    };
-
-
-    // Return true if all bits are clear.
-    template<size_t size>
-    inline bool BitSet<size>::none() const {
-        if (nWords == 1)
-            return !words[0];
-        else {
-            const uint32 *w = words;
-            while (w != words + nWords)
-                if (*w++)
-                    return false;
-            return true;
-        }
-    }
-
-    // Return true if the BitSets are equal.
-    template<size_t size>
-    inline bool BitSet<size>::operator==(const BitSet &s) const {
-        if (nWords == 1)
-            return words[0] == s.words[0];
-        else
-            return std::equal(words, s.words);
-    }
-
-    // Return true if the BitSets are not equal.
-    template<size_t size>
-    inline bool BitSet<size>::operator!=(const BitSet &s) const {
-        return !operator==(s);
-    }
-
-    // Set all bits between low inclusive and high exclusive.
-    template<size_t size>
-    void BitSet<size>::setRange(size_t low, size_t high) {
-        ASSERT(low <= high && high <= size);
-        if (low != high)
-            if (nWords == 1)
-                words[0] |= (2u<<(high-1)) - (1u<<low);
-            else {
-                --high;
-                uint32 *w = words + (low>>5);
-                uint32 *wHigh = words + (high>>5);
-                uint32 l = 1u << (low&31);
-                uint32 h = 2u << (high&31);
-                if (w == wHigh)
-                    *w |= h - l;
-                else {
-                    *w++ |= -l;
-                    while (w != wHigh)
-                        *w++ = static_cast<uint32>(-1);
-                    *w |= h - 1;
-                }
-            }
-    }
-
-    // Clear all bits between low inclusive and high exclusive.
-    template<size_t size>
-    void BitSet<size>::resetRange(size_t low, size_t high) {
-        ASSERT(low <= high && high <= size);
-        if (low != high)
-            if (nWords == 1)
-                words[0] &= (1u<<low) - 1 - (2u<<(high-1));
-            else {
-                --high;
-                uint32 *w = words + (low>>5);
-                uint32 *wHigh = words + (high>>5);
-                uint32 l = 1u << (low&31);
-                uint32 h = 2u << (high&31);
-                if (w == wHigh)
-                    *w &= l - 1 - h;
-                else {
-                    *w++ &= l - 1;
-                    while (w != wHigh)
-                        *w++ = 0;
-                    *w &= -h;
-                }
-            }
-    }
-
-    // Invert all bits between low inclusive and high exclusive.
-    template<size_t size>
-    void BitSet<size>::flipRange(size_t low, size_t high) {
-        ASSERT(low <= high && high <= size);
-        if (low != high)
-            if (nWords == 1)
-                words[0] ^= (2u<<(high-1)) - (1u<<low);
-            else {
-                --high;
-                uint32 *w = words + (low>>5);
-                uint32 *wHigh = words + (high>>5);
-                uint32 l = 1u << (low&31);
-                uint32 h = 2u << (high&31);
-                if (w == wHigh)
-                    *w ^= h - l;
-                else {
-                    *w++ ^= -l;
-                    while (w != wHigh)
-                        *w++ ^= static_cast<uint32>(-1);
-                    *w ^= h - 1;
-                }
-            }
-    }
-
-
-//
-// Array Queues
-//
-
-    // See ArrayQueue below.
-    template <typename T> class RawArrayQueue {
-        T *const cache;                 // Pointer to a fixed-size cache for holding the buffer if it's small enough
-      protected:
-        T *buffer;                      // Pointer to the current buffer
-        T *bufferEnd;                   // Pointer to the end of the buffer
-        T *f;                           // Front end of the circular buffer, used for reading elements; buffer <= f < bufferEnd
-        T *b;                           // Back end of the circular buffer, used for writing elements; buffer < b <= bufferEnd
-        size_t length;                  // Number of elements used in the circular buffer
-        size_t bufferSize;              // Physical size of the buffer
-#ifdef DEBUG
-        size_t maxReservedSize;         // Maximum size reserved so far
-#endif
-
-      public:
-        RawArrayQueue(T *cache, size_t cacheSize):
-                cache(cache), buffer(cache), bufferEnd(cache + cacheSize),
-                f(cache), b(cache), length(0), bufferSize(cacheSize)
-            {DEBUG_ONLY(maxReservedSize = 0);}
-      private:
-        RawArrayQueue(const RawArrayQueue&);        // No copy constructor
-        void operator=(const RawArrayQueue&);       // No assignment operator
-      public:
-        ~RawArrayQueue() {if (buffer != cache) delete[] buffer;}
-
-      private:
-        void enlarge(size_t newLength);
-      public:
-
-        // Methods that do not expand the buffer cannot throw exceptions.
-        size_t size() const {return length;}
-        operator bool() const {return length != 0;}
-        bool operator !() const {return length == 0;}
-        
-        T &front() {ASSERT(length); return *f;}
-        const T &front() const {ASSERT(length); return *f;}
-        T &back() {ASSERT(length); return b[-1];}
-        const T &back() const {ASSERT(length); return b[-1];}
-        
-        T &pop_front() {
-            ASSERT(length);
-            --length;
-            T &elt = *f++;
-            if (f == bufferEnd)
-                f = buffer;
-            return elt;
-        }
-        
-        size_t pop_front(size_t nElts, T *&begin, T *&end);
-
-        T &pop_back() {
-            ASSERT(length);
-            --length;
-            T &elt = *--b;
-            if (b == buffer)
-                b = bufferEnd;
-            return elt;
-        }
-
-        void reserve_back();
-        void reserve_back(size_t nElts);
-        T *advance_back();
-        T *advance_back(size_t nElts, size_t &nEltsAdvanced);
-
-        void fast_push_back(const T &elt);
-        void push_back(const T &elt);
-
-        // Same as append but assumes that memory has previously been reserved.
-        // Does not throw exceptions.  T::operator= must not throw exceptions.
-        template <class InputIter>
-        void fast_append(InputIter begin, InputIter end) {
-            size_t nElts = toSize_t(std::distance(begin, end));
-            ASSERT(length + nElts <= maxReservedSize);
-            while (nElts) {
-                size_t nEltsAdvanced;
-                T *dst = advance_back(nElts, nEltsAdvanced);
-                nElts -= nEltsAdvanced;
-                while (nEltsAdvanced--) {
-                    *dst = *begin; ++dst; ++begin;
-                }
-            }
-        }
-
-        // Append elements from begin to end to the back of the queue.
-        // T::operator= must not throw exceptions.
-        // reserve_back may throw an exception, in which case the queue is left
-        // unchanged.
-        template <class InputIter> void append(InputIter begin, InputIter end) {
-            size_t nElts = toSize_t(std::distance(begin, end));
-            reserve_back(nElts);
-            while (nElts) {
-                size_t nEltsAdvanced;
-                T *dst = advance_back(nElts, nEltsAdvanced);
-                nElts -= nEltsAdvanced;
-                while (nEltsAdvanced--) {
-                    *dst = *begin; ++dst; ++begin;
-                }
-            }
-        }
-    };
-
-
-    // Pop between one and nElts elements from the front of the queue.  Set begin
-    // and end to an array of the first n elements, where n is the return value.
-    // The popped elements may be accessed until the next non-const operation.
-    // Does not throw exceptions.
-    template <typename T>
-    size_t RawArrayQueue<T>::pop_front(size_t nElts, T *&begin, T *&end) {
-        ASSERT(nElts <= length);
-        begin = f;
-        size_t eltsToEnd = toSize_t(bufferEnd - f);
-        if (nElts < eltsToEnd) {
-            length -= nElts;
-            f += nElts;
-            end = f;
-            return nElts;
-        } else {
-            length -= eltsToEnd;
-            end = bufferEnd;
-            f = buffer;
-            return eltsToEnd;
-        }
-    }
-
-    // Enlarge the buffer so that it can hold at least newLength elements.
-    // May throw an exception, in which case the queue is left unchanged.
-    template <typename T>
-    void RawArrayQueue<T>::enlarge(size_t newLength) {
-        size_t newBufferSize = bufferSize * 2;
-        if (newBufferSize < newLength)
-            newBufferSize = newLength;
-        
-        auto_ptr<T> newBuffer(new T[newBufferSize]);
-        T *oldBuffer = buffer;
-        size_t eltsToEnd = toSize_t(bufferEnd - f);
-        if (eltsToEnd <= length)
-            std::copy(f, f + eltsToEnd, newBuffer.get());
-        else {
-            std::copy(f, bufferEnd, newBuffer.get());
-            std::copy(oldBuffer, b, newBuffer.get() + eltsToEnd);
-        }
-        buffer = newBuffer.release();
-        f = buffer;
-        b = buffer + length;
-        if (oldBuffer != cache)
-            delete[] oldBuffer;
-        bufferSize = newBufferSize;
-    }
-
-    // Ensure that there is room to hold one more element at the back of the queue,
-    // without expanding the queue's logical length.
-    // May throw an exception, in which case the queue is left unchanged.
-    template <typename T>
-    inline void RawArrayQueue<T>::reserve_back() {
-        if (length == bufferSize)
-            enlarge(length + 1);
-#ifdef DEBUG
-        if (maxReservedSize <= length)
-            maxReservedSize = length + 1;
-#endif
-    }
-
-    // Ensure that there is room to hold nElts more elements at the back of the
-    // queue, without expanding the queue's logical length.
-    // May throw an exception, in which case the queue is left unchanged.
-    template <typename T>
-    inline void RawArrayQueue<T>::reserve_back(size_t nElts) {
-        nElts += length;
-        if (bufferSize < nElts)
-            enlarge(nElts);
-#ifdef DEBUG
-        if (maxReservedSize < nElts)
-            maxReservedSize = nElts;
-#endif
-    }
-
-    // Advance the back of the queue by one element, assuming that the memory has
-    // previously been reserved.
-    // Return a pointer to that new element.
-    // Does not throw exceptions.
-    template <typename T>
-    inline T *RawArrayQueue<T>::advance_back() {
-        ASSERT(length < maxReservedSize);
-        ++length;
-        if (b == bufferEnd)
-            b = buffer;
-        return b++;
-    }
-
-    // Advance the back of the queue by between one and nElts elements and return a
-    // pointer to them, assuming that the memory has previously been reserved.
-    // nEltsAdvanced gets the actual number of elements advanced.
-    // Does not throw exceptions.
-    template <typename T>
-    T *RawArrayQueue<T>::advance_back(size_t nElts, size_t &nEltsAdvanced) {
-        size_t newLength = length + nElts;
-        ASSERT(newLength <= maxReservedSize);
-        if (nElts) {
-            T *b2 = b;
-            if (b2 == bufferEnd)
-                b2 = buffer;
-            
-            size_t room = toSize_t(bufferEnd - b2);
-            if (nElts > room) {
-                nElts = room;
-                newLength = length + nElts;
-            }
-            length = newLength;
-            nEltsAdvanced = nElts;
-            b = b2 + nElts;
-            return b2;
-        } else {
-            nEltsAdvanced = 0;
-            return 0;
-        }
-    }
-
-    // Same as push_back but assumes that the memory has previously been reserved.
-    // May throw an exception if copying elt throws one, in which case the queue is
-    // left unchanged.
-    template <typename T>
-    inline void RawArrayQueue<T>::fast_push_back(const T &elt) {
-        ASSERT(length < maxReservedSize);
-        T *b2 = b;
-        if (b2 == bufferEnd)
-            b2 = buffer;
-        *b2 = elt;
-        b = b2 + 1;
-        ++length;
-    }
-
-    // Append elt to the back of the queue.
-    // May throw an exception, in which case the queue is left unchanged.
-    template <typename T>
-    inline void RawArrayQueue<T>::push_back(const T &elt) {
-        reserve_back();
-        T *b2 = b == bufferEnd ? buffer : b;
-        *b2 = elt;
-        b = b2 + 1;
-        ++length;
-    }
-
-
-    // An ArrayQueue represents an array of elements of type T that can be written
-    // at its back end and read at its front or back end.  In addition, arrays of
-    // multiple elements may be written at the back end or read at the front end.
-    // The ArrayQueue contains storage for a fixed size array of cacheSize elements;
-    // if this size is exceeded, the ArrayQueue allocates the array from the heap.
-    template <typename T, size_t cacheSize>
-    class ArrayQueue: public RawArrayQueue<T> {
-        T cacheArray[cacheSize];
-          public:
-        ArrayQueue(): RawArrayQueue<T>(cacheArray, cacheSize) {}
-    };
-
-
-//
-// Array auto_ptr's
-//
-
-    // An ArrayAutoPtr holds a pointer to an array initialized by new T[x].
-    // A regular auto_ptr cannot be used here because it deletes its pointer using
-    // delete rather than delete[].
-    // An appropriate operator[] is also provided.
-    template <typename T> class ArrayAutoPtr {
-        T *ptr;
-        
-      public:
-        explicit ArrayAutoPtr(T *p = 0): ptr(p) {}
-        ArrayAutoPtr(ArrayAutoPtr &a): ptr(a.ptr) {a.ptr = 0;}
-        ArrayAutoPtr &operator=(ArrayAutoPtr &a) {reset(a.release());}
-        ~ArrayAutoPtr() {delete[] ptr;}
-        
-        T &operator*() const {return *ptr;}
-        T &operator->() const {return *ptr;}
-        template<class N> T &operator[](N i) const {return ptr[i];}
-        T *get() const {return ptr;}
-        T *release() {T *p = ptr; ptr = 0; return p;}
-        void reset(T *p = 0) {delete[] ptr; ptr = p;}
-    };
-    
-    typedef ArrayAutoPtr<char> CharAutoPtr;
-}
-#endif /* ds_h___ */

mozilla/js2/src/exception.cpp

@@ -1,85 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#include <cstdio>
-#include "exception.h"
-
-namespace JS = JavaScript;
-
-
-//
-// Exceptions
-//
-
-static const char *const kindStrings[] = {
-    "Syntax error",                         // syntaxError
-    "Stack overflow",                       // stackOverflow
-    "Internal error",                       // diabetes
-    "Runtime error",                        // runtimeError
-    "Reference error",                      // referenceError
-    "Range error",                          // burnt the beans
-    "Type error",                           // Yype error
-    "Uncaught exception error",             // uncaught exception error
-    "Semantic error",                       // semantic error
-};
-
-// Return a null-terminated string describing the exception's kind.
-const char *JS::Exception::kindString() const
-{
-    return kindStrings[kind];
-}
-
-
-// Return the full error message.
-JS::String JS::Exception::fullMessage() const
-{
-    String m(widenCString("In "));
-    m += sourceFile;
-    if (lineNum) {
-        char b[32];
-        sprintf(b, ", line %d:\n", lineNum);
-        m += b;
-        m += sourceLine;
-        m += '\n';
-        String sourceLine2(sourceLine);
-        insertChars(sourceLine2, charNum, "[ERROR]");
-        m += sourceLine2;
-        m += '\n';
-    } else
-        m += ":\n";
-    m += kindString();
-    m += ": ";
-    m += message;
-    m += '\n';
-    return m;
-}

mozilla/js2/src/exception.h

@@ -1,95 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef exception_h___
-#define exception_h___
-
-#include "strings.h"
-
-namespace JavaScript
-{
-
-//
-// Exceptions
-//
-
-    // A JavaScript exception (other than out-of-memory, for which we use the
-    // standard C++ exception bad_alloc).
-    struct Exception {
-        enum Kind {
-            syntaxError,
-            stackOverflow,
-            internalError,
-            runtimeError,
-            referenceError,
-            rangeError,
-            typeError,
-            uncaughtError,
-            semanticError
-        };
-        
-        Kind kind;              // The exception's kind
-        String message;         // The detailed message
-        String sourceFile;      // A description of the source code that caused the error
-        uint32 lineNum;         // Number of line that caused the error
-        size_t charNum;         // Character offset within the line that caused the error
-        size_t pos;             // Offset within the input of the error
-        String sourceLine;      // The text of the source line
-
-        Exception (Kind kind, const char *message):
-                kind(kind), message(widenCString(message)), lineNum(0), charNum(0) {}
-        
-        Exception (Kind kind, const String &message):
-                kind(kind), message(message), lineNum(0), charNum(0) {}
-        
-        Exception(Kind kind, const String &message, const String &sourceFile, uint32 lineNum, size_t charNum,
-                  size_t pos, const String &sourceLine):
-                kind(kind), message(message), sourceFile(sourceFile), lineNum(lineNum), charNum(charNum), pos(pos),
-                sourceLine(sourceLine) {}
-        
-        Exception(Kind kind, const String &message, const String &sourceFile, uint32 lineNum, size_t charNum,
-                  size_t pos, const char16 *sourceLineBegin, const char16 *sourceLineEnd):
-                kind(kind), message(message), sourceFile(sourceFile), lineNum(lineNum), charNum(charNum), pos(pos),
-                sourceLine(sourceLineBegin, sourceLineEnd) {}
-
-        bool hasKind(Kind k) const {return kind == k;}
-        const char *kindString() const;
-        String fullMessage() const;
-    };
-
-
-    // Throw a stackOverflow exception if the execution stack has gotten too large.
-    inline void checkStackSize() {}
-}
-
-#endif /* exception_h___ */

mozilla/js2/src/exception_msgs.cpp

@@ -1,66 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-namespace JavaScript {
-
-    const char* exception_types[] = {
-        "Unknown",
-        "Lexer",
-        "Parser",
-        "Runtime",
-        0
-    };
-    
-    const char* exception_msgs[] = {
-        "Expected boolean value",
-        "Expected double value",
-        "Expected int32 value",
-        "Expected uint32 value",
-        "Expected register value",
-        "Expected argument list value",
-        "Expected colon",
-        "Expected close parenthesis",
-        "Expected binary operator",
-        "Expected string",
-        "Expected label",
-        "Expected comma",
-        "Expected newline",
-        "Expected identifier",
-        "Duplicate label",
-        "Unknown icode",
-        "Unknown binary operator",
-        "Unterminated string literal",
-        0
-    };
-    
-}

mozilla/js2/src/fdlibm_ns.cpp

@@ -1,2 +0,0 @@
-
-// this file intentionally left blank

mozilla/js2/src/fdlibm_ns.h

@@ -1,140 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s):  
- *   Roger Lawrence <rogerl@netscape.com>
- *   Patrick Beard <beard@netscape.com>
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#include <math.h>
-
-#if defined(_WIN32) && !defined(__MWERKS__)
-#define __STDC__
-#endif
-
-/*
- * Use math routines in fdlibm.
- */
-
-#undef __P
-#ifdef __STDC__
-#define __P(p)  p
-#else
-#define __P(p)  ()
-#endif
-
-#if defined _WIN32 || defined SUNOS4 
-
-// these are functions we trust the local implementation
-// to provide, so we just inline them into calls to the
-// standard library.
-namespace fd {
-    inline double floor(double x)           { return ::floor(x); }
-    inline double acos(double x)            { return ::acos(x); }
-    inline double asin(double x)            { return ::asin(x); }
-    inline double atan(double x)            { return ::atan(x); }
-    inline double cos(double x)             { return ::cos(x); }
-    inline double sin(double x)             { return ::sin(x); }
-    inline double tan(double x)             { return ::tan(x); }
-    inline double exp(double x)             { return ::exp(x); }
-    inline double log(double x)             { return ::log(x); }
-    inline double sqrt(double x)            { return ::sqrt(x); }
-    inline double ceil(double x)            { return ::ceil(x); }
-    inline double fabs(double x)            { return ::fabs(x); }
-    inline double fmod(double x, double y)  { return ::fmod(x, y); }
-}
-
-// these one we get from the fdlibm library
-namespace fd {
-    extern "C" {
-        double fd_atan2 __P((double, double));
-        double fd_copysign __P((double, double));
-        double fd_pow __P((double, double));
-    }
-    inline double atan2(double x, double y)      { return fd_atan2(x, y); }
-    inline double copysign(double x, double y)   { return fd_copysign(x, y); }
-    inline double pow(double x, double y)        { return fd_pow(x, y); }
-}
-
-
-#elif defined(linux)
-
-namespace fd {
-    inline double atan(double x)               { return ::atan(x); }
-    inline double atan2(double x, double y)    { return ::atan2(x, y); }
-    inline double ceil(double x)               { return ::ceil(x); }
-    inline double cos(double x)                { return ::cos(x); }
-    inline double fabs(double x)               { return ::fabs(x); }
-    inline double floor(double x)              { return ::floor(x); }
-    inline double fmod(double x, double y)     { return ::fmod(x, y); }
-    inline double sin(double x)                { return ::sin(x); }
-    inline double sqrt(double x)               { return ::sqrt(x); }
-    inline double tan(double x)                { return ::tan(x); }
-    inline double copysign(double x, double y) { return ::copysign(x, y); }
-}
-
-namespace fd {
-    extern "C" {
-        double fd_asin __P((double));
-        double fd_acos __P((double));
-        double fd_exp __P((double));
-        double fd_log __P((double));
-        double fd_pow __P((double, double));
-    }
-    inline double asin(double x)                 { return fd_asin(x); }
-    inline double acos(double x)                 { return fd_acos(x); }
-    inline double exp(double x)                  { return fd_exp(x); }
-    inline double log(double x)                  { return fd_log(x); }
-    inline double pow(double x, double y)        { return fd_pow(x, y); }
-}
-
-#elif defined(macintosh)
-
-// the macintosh MSL provides acceptable implementations for all of these.
-namespace fd {
-    inline double atan(double x)               { return ::atan(x); }
-    inline double atan2(double x, double y)    { return ::atan2(x, y); }
-    inline double ceil(double x)               { return ::ceil(x); }
-    inline double cos(double x)                { return ::cos(x); }
-    inline double fabs(double x)               { return ::fabs(x); }
-    inline double floor(double x)              { return ::floor(x); }
-    inline double fmod(double x, double y)     { return ::fmod(x, y); }
-    inline double sin(double x)                { return ::sin(x); }
-    inline double sqrt(double x)               { return ::sqrt(x); }
-    inline double tan(double x)                { return ::tan(x); }
-    inline double copysign(double x, double y) { return ::copysign(x, y); }
-    inline double asin(double x)               { return ::asin(x); }
-    inline double acos(double x)               { return ::acos(x); }
-    inline double exp(double x)                { return ::exp(x); }
-    inline double log(double x)                { return ::log(x); }
-    inline double pow(double x, double y)      { return ::pow(x, y); }
-}
-
-#endif

mozilla/js2/src/formatter.cpp

@@ -1,880 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
-*
-* The contents of this file are subject to the Netscape Public
-* License Version 1.1 (the "License"); you may not use this file
-* except in compliance with the License. You may obtain a copy of
-* the License at http://www.mozilla.org/NPL/
-*
-* Software distributed under the License is distributed on an "AS
-* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-* implied. See the License for the specific language governing
-* rights and limitations under the License.
-*
-* The Original Code is the JavaScript 2 Prototype.
-*
-* The Initial Developer of the Original Code is Netscape
-* Communications Corporation.   Portions created by Netscape are
-* Copyright (C) 1998 Netscape Communications Corporation. All
-* Rights Reserved.
-*
-* Contributor(s):
-*
-* Alternatively, the contents of this file may be used under the
-* terms of the GNU Public License (the "GPL"), in which case the
-* provisions of the GPL are applicable instead of those above.
-* If you wish to allow use of your version of this file only
-* under the terms of the GPL and not to allow others to use your
-* version of this file under the NPL, indicate your decision by
-* deleting the provisions above and replace them with the notice
-* and other provisions required by the GPL.  If you do not delete
-* the provisions above, a recipient may use your version of this
-* file under either the NPL or the GPL.
-*/
-
-#include "algo.h"
-#include "formatter.h"
-
-namespace JS = JavaScript;
-
-
-static const char controlCharNames[6] = {'b', 't', 'n', 'v', 'f', 'r'};
-
-// Print the characters from begin to end, escaping them as necessary to make
-// the resulting string be readable if placed between two quotes specified by
-// quote (which should be either '\'' or '"').
-void JS::escapeString(Formatter &f, const char16 *begin, const char16 *end, char16 quote)
-{
-    ASSERT(begin <= end);
-
-    const char16 *chunk = begin;
-    while (begin != end) {
-        char16 ch = *begin++;
-        CharInfo ci(ch);
-        if (char16Value(ch) < 0x20 || isLineBreak(ci) || isFormat(ci) || ch == '\\' || ch == quote) {
-            if (begin-1 != chunk)
-                printString(f, chunk, begin-1);
-            chunk = begin;
-
-            f << '\\';
-            switch (ch) {
-              case 0x0008:
-              case 0x0009:
-              case 0x000A:
-              case 0x000B:
-              case 0x000C:
-              case 0x000D:
-                f << controlCharNames[ch - 0x0008];
-                break;
-
-              case '\'':
-              case '"':
-              case '\\':
-                f << ch;
-                break;
-
-              case 0x0000:
-                if (begin == end || char16Value(*begin) < '0' || char16Value(*begin) > '9') {
-                    f << '0';
-                    break;
-                }
-              default:
-                if (char16Value(ch) <= 0xFF) {
-                    f << 'x';
-                    printHex(f, static_cast<uint32>(char16Value(ch)), 2);
-                } else {
-                    f << 'u';
-                    printHex(f, static_cast<uint32>(char16Value(ch)), 4);
-                }
-            }
-        }
-    }
-    if (begin != chunk)
-        printString(f, chunk, begin);
-}
-
-
-// Print s as a quoted string using the given quotes (which should be
-// either '\'' or '"').
-void JS::quoteString(Formatter &f, const String &s, char16 quote)
-{
-    f << quote;
-    const char16 *begin = s.data();
-    escapeString(f, begin, begin + s.size(), quote);
-    f << quote;
-}
-
-
-#ifdef XP_MAC_MPW
-// Macintosh MPW replacements for the ANSI routines.  These translate LF's to
-// CR's because the MPW libraries supplied by Metrowerks don't do that for some
-// reason.
-static void translateLFtoCR(char *begin, char *end)
-{
-    while (begin != end) {
-        if (*begin == '\n')
-            *begin = '\r';
-        ++begin;
-    }
-}
-
-
-size_t JS::printChars(FILE *file, const char *begin, const char *end)
-{
-    ASSERT(end >= begin);
-    size_t n = toSize_t(end - begin);
-    size_t extra = 0;
-    char buffer[1024];
-
-    while (n > sizeof buffer) {
-        std::memcpy(buffer, begin, sizeof buffer);
-        translateLFtoCR(buffer, buffer + sizeof buffer);
-        extra += fwrite(buffer, 1, sizeof buffer, file);
-        n -= sizeof buffer;
-        begin += sizeof buffer;
-    }
-    std::memcpy(buffer, begin, n);
-    translateLFtoCR(buffer, buffer + n);
-    return extra + fwrite(buffer, 1, n, file);
-}
-
-
-int std::fputc(int c, FILE *file)
-{
-    char buffer = static_cast<char>(c);
-    if (buffer == '\n')
-        buffer = '\r';
-    return static_cast<int>(fwrite(&buffer, 1, 1, file));
-}
-
-
-int std::fputs(const char *s, FILE *file)
-{
-    return static_cast<int>(printChars(file, s, s + strlen(s)));
-}
-
-
-int std::fprintf(FILE* file, const char *format, ...)
-{
-    Buffer<char, 1024> b;
-
-    while (true) {
-        va_list args;
-        va_start(args, format);
-        int n = vsnprintf(b.buffer, b.size, format, args);
-        va_end(args);
-        if (n >= 0 && n < b.size) {
-            translateLFtoCR(b.buffer, b.buffer + n);
-            return static_cast<int>(fwrite(b.buffer, 1, toSize_t(n), file));
-        }
-        b.expand(b.size*2);
-    }
-}
-#endif // XP_MAC_MPW
-
-
-// Write ch.
-void JS::Formatter::printChar8(char ch)
-{
-    printStr8(&ch, &ch + 1);
-}
-
-
-// Write ch.
-void JS::Formatter::printChar16(char16 ch)
-{
-    printStr16(&ch, &ch + 1);
-}
-
-
-// Write the null-terminated string str.
-void JS::Formatter::printZStr8(const char *str)
-{
-    printStr8(str, str + strlen(str));
-}
-
-
-// Write the String s.
-void JS::Formatter::printString16(const String &s)
-{
-    const char16 *begin = s.data();
-    printStr16(begin, begin + s.size());
-}
-
-
-// Write the printf format using the supplied args.
-void JS::Formatter::printVFormat8(const char *format, va_list args)
-{
-    Buffer<char, 1024> b;
-
-    while (true) {
-        int n = vsnprintf(b.buffer, b.size, format, args);
-        if (n >= 0 && static_cast<uint>(n) < b.size) {
-            printStr8(b.buffer, b.buffer + n);
-            return;
-        }
-        b.expand(b.size*2);
-    }
-}
-
-
-// Write either "true" or "false".
-JS::Formatter &JS::Formatter::operator<<(bool b)
-{
-    printZStr8(b ? "true" : "false");
-    return *this;
-}
-
-
-// Write the printf format using the supplied args.
-void JS::printFormat(Formatter &f, const char *format, ...)
-{
-    va_list args;
-    va_start(args, format);
-    f.printVFormat8(format, args);
-    va_end(args);
-}
-
-
-static const int printCharBufferSize = 64;
-
-// Print ch count times.
-void JS::printChar(Formatter &f, char ch, int count)
-{
-    char str[printCharBufferSize];
-
-    while (count > 0) {
-        int c = count;
-        if (c > printCharBufferSize)
-            c = printCharBufferSize;
-        count -= c;
-        STD::memset(str, ch, toSize_t(c));
-        printString(f, str, str+c);
-    }
-}
-
-
-// Print ch count times.
-void JS::printChar(Formatter &f, char16 ch, int count)
-{
-    char16 str[printCharBufferSize];
-
-    while (count > 0) {
-        int c = count;
-        if (c > printCharBufferSize)
-            c = printCharBufferSize;
-        count -= c;
-        char16 *strEnd = str + c;
-        std::fill(str, strEnd, ch);
-        printString(f, str, strEnd);
-    }
-}
-
-
-// Print i using the given formatting string, padding on the left with pad
-// characters to use at least nDigits characters.
-void JS::printNum(Formatter &f, uint32 i, int nDigits, char pad, const char *format)
-{
-    char str[20];
-    int n = sprintf(str, format, i);
-    if (n < nDigits)
-        printChar(f, pad, nDigits - n);
-    printString(f, str, str+n);
-}
-
-
-// Print p as a pointer.
-void JS::printPtr(Formatter &f, void *p)
-{
-    char str[20];
-    int n = sprintf(str, "%p", p);
-    printString(f, str, str+n);
-}
-
-
-// printf formats for printing non-ASCII characters on an ASCII stream
-#ifdef XP_MAC
-static const char unprintableFormat[] = "\xC7%.4X\xC8"; // Use angle quotes
-#elif defined _WIN32
-static const char unprintableFormat[] = "\xAB%.4X\xBB"; // Use angle quotes
-#else
-static const char unprintableFormat[] = "<%.4X>";
-#endif
-
-
-static const uint16 defaultFilterRanges[] = {
-    0x00, 0x09,     // Filter all control characters except \t and \n
-    0x0B, 0x20,
-    0x7F, 0x100,    // Filter all non-ASCII characters
-    0, 0
-};
-
-JS::BitSet<256> JS::AsciiFileFormatter::defaultFilter(defaultFilterRanges);
-
-
-// Construct an AsciiFileFormatter using the given file and filter f.
-// If f is nil, use the default filter.
-JS::AsciiFileFormatter::AsciiFileFormatter(FILE *file, BitSet<256> *f): file(file)
-#ifndef _WIN32  // Microsoft Visual C++ 6.0 bug
-    , filter(f ? *f : defaultFilter)
-#endif
-{
-#ifdef _WIN32       // Microsoft Visual C++ 6.0 bug
-    if (f)
-        filter = *f;
-    else
-        filter = defaultFilter;
-#endif
-    filterEmpty = filter.none();
-}
-
-
-// Write ch, escaping non-ASCII characters.
-void JS::AsciiFileFormatter::printChar8(char ch)
-{
-    if (filterChar(ch))
-        fprintf(file, unprintableFormat, static_cast<uchar>(ch));
-    else
-        fputc(ch, file);
-}
-
-
-// Write ch, escaping non-ASCII characters.
-void JS::AsciiFileFormatter::printChar16(char16 ch)
-{
-    if (filterChar(ch))
-        fprintf(file, unprintableFormat, char16Value(ch));
-    else
-        fputc(static_cast<char>(ch), file);
-}
-
-
-// Write the null-terminated string str, escaping non-ASCII characters.
-void JS::AsciiFileFormatter::printZStr8(const char *str)
-{
-    if (filterEmpty)
-        fputs(str, file);
-    else
-        printStr8(str, str + strlen(str));
-}
-
-
-// Write the string between strBegin and strEnd, escaping non-ASCII characters.
-void JS::AsciiFileFormatter::printStr8(const char *strBegin, const char *strEnd)
-{
-    if (filterEmpty)
-        printChars(file, strBegin, strEnd);
-    else {
-        ASSERT(strEnd >= strBegin);
-        const char *p = strBegin;
-        while (strBegin != strEnd) {
-            char ch = *strBegin;
-            if (filterChar(ch)) {
-                if (p != strBegin) {
-                    printChars(file, p, strBegin);
-                    p = strBegin;
-                }
-                fprintf(file, unprintableFormat, static_cast<uchar>(ch));
-            }
-            ++strBegin;
-        }
-        if (p != strBegin)
-            printChars(file, p, strBegin);
-    }
-}
-
-
-// Write the string between strBegin and strEnd, escaping non-ASCII characters.
-void JS::AsciiFileFormatter::printStr16(const char16 *strBegin, const char16 *strEnd)
-{
-    char buffer[512];
-
-    ASSERT(strEnd >= strBegin);
-    char *q = buffer;
-    while (strBegin != strEnd) {
-        char16 ch = *strBegin++;
-        if (filterChar(ch)) {
-            if (q != buffer) {
-                printChars(file, buffer, q);
-                q = buffer;
-            }
-            fprintf(file, unprintableFormat, char16Value(ch));
-        } else {
-            *q++ = static_cast<char>(ch);
-            if (q == buffer + sizeof buffer) {
-                printChars(file, buffer, buffer + sizeof buffer);
-                q = buffer;
-            }
-        }
-    }
-    if (q != buffer)
-        printChars(file, buffer, q);
-}
-
-
-JS::AsciiFileFormatter JS::stdOut(stdout);
-JS::AsciiFileFormatter JS::stdErr(stderr);
-
-
-// Write ch.
-void JS::StringFormatter::printChar8(char ch)
-{
-    s += ch;
-}
-
-
-// Write ch.
-void JS::StringFormatter::printChar16(char16 ch)
-{
-    s += ch;
-}
-
-
-// Write the null-terminated string str.
-void JS::StringFormatter::printZStr8(const char *str)
-{
-    s += str;
-}
-
-
-// Write the string between strBegin and strEnd.
-void JS::StringFormatter::printStr8(const char *strBegin, const char *strEnd)
-{
-    appendChars(s, strBegin, strEnd);
-}
-
-
-// Write the string between strBegin and strEnd.
-void JS::StringFormatter::printStr16(const char16 *strBegin, const char16 *strEnd)
-{
-    s.append(strBegin, strEnd);
-}
-
-
-// Write the String str.
-void JS::StringFormatter::printString16(const String &str)
-{
-    s += str;
-}
-
-
-
-//
-// Formatted Output
-//
-
-// See "Prettyprinting" by Derek Oppen in ACM Transactions on Programming
-// Languages and Systems 2:4, October 1980, pages 477-482 for the algorithm.
-
-// The default line width for pretty printing
-uint32 JS::PrettyPrinter::defaultLineWidth = 20;
-
-
-// Create a PrettyPrinter that outputs to Formatter f.  The PrettyPrinter
-// breaks lines at optional breaks so as to try not to exceed lines of width
-// lineWidth, although it may not always be able to do so.  Formatter f should
-// be at the beginning of a line. Call end before destroying the Formatter;
-// otherwise the last line may not be output to f.
-JS::PrettyPrinter::PrettyPrinter(Formatter &f, uint32 lineWidth):
-        lineWidth(min(lineWidth, static_cast<uint32>(unlimitedLineWidth))),
-        outputFormatter(f),
-        outputPos(0),
-        lineNum(0),
-        lastBreak(0),
-        margin(0),
-        nNestedBlocks(0),
-        leftSerialPos(0),
-        rightSerialPos(0),
-        itemPool(20)
-{
-#ifdef DEBUG
-    topRegion = 0;
-#endif
-}
-
-
-// Destroy the PrettyPrinter.  Because it's a very bad idea for a destructor to
-// throw exceptions, this destructor does not flush any buffered output.  Call
-// end just before destroying the PrettyPrinter to do that.
-JS::PrettyPrinter::~PrettyPrinter()
-{
-    ASSERT(!topRegion && !nNestedBlocks);
-}
-
-
-// Output either a line break (if sameLine is false) or length spaces (if
-// sameLine is true). Also advance leftSerialPos by length.
-//
-// If this method throws an exception, it is guaranteed to already have updated
-// all of the PrettyPrinter state; all that might be missing would be some
-// output to outputFormatter.
-void JS::PrettyPrinter::outputBreak(bool sameLine, uint32 length)
-{
-    leftSerialPos += length;
-
-    if (sameLine) {
-        outputPos += length;
-        // Exceptions may be thrown below.
-        printChar(outputFormatter, ' ', static_cast<int>(length));
-    } else {
-        lastBreak = ++lineNum;
-        outputPos = margin;
-        // Exceptions may be thrown below.
-        outputFormatter << '\n';
-        printChar(outputFormatter, ' ', static_cast<int>(margin));
-    }
-}
-
-
-// Check to see whether (rightSerialPos+rightOffset)-leftSerialPos has gotten so large that we may pop items
-// off the left end of activeItems because their totalLengths are known to be larger than the
-// amount of space left on the current line.
-// Return true if there are any items left on activeItems.
-//
-// If this method throws an exception, it leaves the PrettyPrinter in a consistent state, having
-// atomically popped off one or more items from the left end of activeItems.
-bool JS::PrettyPrinter::reduceLeftActiveItems(uint32 rightOffset)
-{
-    uint32 newRightSerialPos = rightSerialPos + rightOffset;
-    while (activeItems) {
-        Item *leftItem = &activeItems.front();
-        if (itemStack && leftItem == itemStack.front()) {
-            if (outputPos + newRightSerialPos - leftSerialPos > lineWidth) {
-                itemStack.pop_front();
-                leftItem->lengthKnown = true;
-                leftItem->totalLength = infiniteLength;
-            } else if (leftItem->lengthKnown)
-                itemStack.pop_front();
-        }
-
-        if (!leftItem->lengthKnown)
-            return true;
-
-        activeItems.pop_front();
-        try {
-            uint32 length = leftItem->length;
-            switch (leftItem->kind) {
-              case Item::text:
-                {
-                    outputPos += length;
-                    leftSerialPos += length;
-                        // Exceptions may be thrown below.
-                    char16 *textBegin;
-                    char16 *textEnd;
-                    do {
-                        length -= itemText.pop_front(length, textBegin, textEnd);
-                        printString(outputFormatter, textBegin, textEnd);
-                    } while (length);
-                }
-                break;
-
-              case Item::blockBegin:
-              case Item::indentBlockBegin:
-                {
-                    BlockInfo *b = savedBlocks.advance_back();
-                    b->margin = margin;
-                    b->lastBreak = lastBreak;
-                    b->fits = outputPos + leftItem->totalLength <= lineWidth;
-                    if (leftItem->hasKind(Item::blockBegin))
-                        margin = outputPos;
-                    else
-                        margin += length;
-                }
-                break;
-
-              case Item::blockEnd:
-                {
-                    BlockInfo &b = savedBlocks.pop_back();
-                    margin = b.margin;
-                    lastBreak = b.lastBreak;
-                }
-                break;
-
-              case Item::indent:
-                margin += length;
-                ASSERT(static_cast<int32>(margin) >= 0);
-                break;
-
-              case Item::linearBreak:
-                // Exceptions may be thrown below, but only after updating the PrettyPrinter.
-                outputBreak(savedBlocks.back().fits, length);
-                break;
-
-              case Item::fillBreak:
-                // Exceptions may be thrown below, but only after updating the PrettyPrinter.
-                outputBreak(lastBreak == lineNum && outputPos + leftItem->totalLength <= lineWidth, length);
-                break;
-            }
-        } catch (...) {
-            itemPool.destroy(leftItem);
-            throw;
-        }
-        itemPool.destroy(leftItem);
-    }
-    return false;
-}
-
-
-// A break or end of input is about to be processed.  Check whether there are
-// any complete blocks or clumps on the itemStack whose lengths we can now
-// compute; if so, compute these and pop them off the itemStack.
-// The current rightSerialPos must be the beginning of the break or end of input.
-//
-// This method can't throw exceptions.
-void JS::PrettyPrinter::reduceRightActiveItems()
-{
-    uint32 nUnmatchedBlockEnds = 0;
-    while (itemStack) {
-        Item *rightItem = itemStack.pop_back();
-        switch (rightItem->kind) {
-          case Item::blockBegin:
-          case Item::indentBlockBegin:
-            if (!nUnmatchedBlockEnds) {
-                itemStack.fast_push_back(rightItem);
-                return;
-            }
-            rightItem->computeTotalLength(rightSerialPos);
-            --nUnmatchedBlockEnds;
-            break;
-
-          case Item::blockEnd:
-            ++nUnmatchedBlockEnds;
-            break;
-
-          case Item::linearBreak:
-          case Item::fillBreak:
-            rightItem->computeTotalLength(rightSerialPos);
-            if (!nUnmatchedBlockEnds)
-                // There can be at most one consecutive break posted on the itemStack.
-                return;
-            break;
-
-          default:
-            ASSERT(false);  // Other kinds can't be pushed onto the itemStack.
-        }
-    }
-}
-
-
-// Indent the beginning of every new line after this one by offset until the
-// corresponding endIndent call.  Return an Item to pass to endIndent that will
-// end this indentation. This method may throw an exception, in which case the
-// PrettyPrinter is left unchanged.
-JS::PrettyPrinter::Item &JS::PrettyPrinter::beginIndent(int32 offset)
-{
-    Item *unindent = new(itemPool) Item(Item::indent, static_cast<uint32>(-offset));
-    if (activeItems) {
-        try {
-            activeItems.push_back(*new(itemPool) Item(Item::indent, static_cast<uint32>(offset)));
-        } catch (...) {
-            itemPool.destroy(unindent);
-            throw;
-        }
-    } else {
-        margin += offset;
-        ASSERT(static_cast<int32>(margin) >= 0);
-    }
-    return *unindent;
-}
-
-
-// End an indent began by beginIndent.  i should be the result of a beginIndent.
-// This method can't throw exceptions (it's called by the Indent destructor).
-void JS::PrettyPrinter::endIndent(Item &i)
-{
-    if (activeItems)
-        activeItems.push_back(i);
-    else {
-        margin += i.length;
-        ASSERT(static_cast<int32>(margin) >= 0);
-        itemPool.destroy(&i);
-    }
-}
-
-
-// Begin a logical block.  If kind is Item::indentBlockBegin, offset is the
-// indent to use for the second and subsequent lines of this block.
-// Return an Item to pass to endBlock that will end this block.
-// This method may throw an exception, in which case the PrettyPrinter is left
-// unchanged.
-JS::PrettyPrinter::Item &JS::PrettyPrinter::beginBlock(Item::Kind kind, int32 offset)
-{
-    uint32 newNNestedBlocks = nNestedBlocks + 1;
-    savedBlocks.reserve(newNNestedBlocks);
-    itemStack.reserve_back(1 + newNNestedBlocks);
-    Item *endItem = new(itemPool) Item(Item::blockEnd);
-    Item *beginItem;
-    try {
-        beginItem = new(itemPool) Item(kind, static_cast<uint32>(offset), rightSerialPos);
-    } catch (...) {
-        itemPool.destroy(endItem);
-        throw;
-    }
-    // No state modifications before this point.
-    // No exceptions after this point.
-    activeItems.push_back(*beginItem);
-    itemStack.fast_push_back(beginItem);
-    nNestedBlocks = newNNestedBlocks;
-    return *endItem;
-}
-
-
-// End a logical block began by beginBlock.  i should be the result of a
-// beginBlock.
-// This method can't throw exceptions (it's called by the Block destructor).
-void JS::PrettyPrinter::endBlock(Item &i)
-{
-    activeItems.push_back(i);
-    itemStack.fast_push_back(&i);
-    --nNestedBlocks;
-}
-
-
-// Write a conditional line break.  This kind of a line break can only be
-// emitted inside a block.
-// A linear line break starts a new line if the containing block cannot be put
-// all one one line; otherwise the line break is replaced by nSpaces spaces.
-// Typically a block contains several linear breaks; either they all start new
-// lines or none of them do.
-// Moreover, if a block directly contains a required break then linear breaks
-// become required breaks.
-//
-// A fill line break starts a new line if either the preceding clump or the
-// following clump cannot be placed entirely on one line or if the following
-// clump would not fit on the current line.  A clump is a consecutive sequence
-// of strings and nested blocks delimited by either a break or the beginning or
-// end of the currently enclosing block.
-//
-// If this method throws an exception, it leaves the PrettyPrinter in a
-// consistent state.
-void JS::PrettyPrinter::conditionalBreak(uint32 nSpaces, Item::Kind kind)
-{
-    ASSERT(nSpaces <= unlimitedLineWidth && nNestedBlocks);
-    reduceRightActiveItems();
-    itemStack.reserve_back(1 + nNestedBlocks);
-    // Begin of exception-atomic stack update.  Only new(itemPool) can throw
-    // an exception here, in which case nothing is updated.
-    Item *i = new(itemPool) Item(kind, nSpaces, rightSerialPos);
-    activeItems.push_back(*i);
-    itemStack.fast_push_back(i);
-    rightSerialPos += nSpaces;
-    // End of exception-atomic stack update.
-    reduceLeftActiveItems(0);
-}
-
-
-// Write the string between strBegin and strEnd.  Any embedded newlines ('\n'
-// only) become required line breaks.
-//
-// If this method throws an exception, it may have partially formatted the
-// string but leaves the PrettyPrinter in a consistent state.
-void JS::PrettyPrinter::printStr8(const char *strBegin, const char *strEnd)
-{
-    while (strBegin != strEnd) {
-        const char *sectionEnd = findValue(strBegin, strEnd, '\n');
-        uint32 sectionLength = static_cast<uint32>(sectionEnd - strBegin);
-        if (sectionLength) {
-            if (reduceLeftActiveItems(sectionLength)) {
-                itemText.reserve_back(sectionLength);
-                Item &backItem = activeItems.back();
-                // Begin of exception-atomic update.  Only new(itemPool) can throw an exception here,
-                // in which case nothing is updated.
-                if (backItem.hasKind(Item::text))
-                    backItem.length += sectionLength;
-                else
-                    activeItems.push_back(*new(itemPool) Item(Item::text, sectionLength));
-                rightSerialPos += sectionLength;
-                itemText.fast_append(reinterpret_cast<const uchar *>(strBegin), reinterpret_cast<const uchar *>(sectionEnd));
-                // End of exception-atomic update.
-            } else {
-                ASSERT(!itemStack && !activeItems && !itemText && leftSerialPos == rightSerialPos);
-                outputPos += sectionLength;
-                printString(outputFormatter, strBegin, sectionEnd);
-            }
-            strBegin = sectionEnd;
-            if (strBegin == strEnd)
-                break;
-        }
-        requiredBreak();
-        ++strBegin;
-    }
-}
-
-
-// Write the string between strBegin and strEnd.  Any embedded newlines ('\n'
-// only) become required line breaks.
-//
-// If this method throws an exception, it may have partially formatted the
-// string but leaves the PrettyPrinter in a consistent state.
-void JS::PrettyPrinter::printStr16(const char16 *strBegin, const char16 *strEnd)
-{
-    while (strBegin != strEnd) {
-        const char16 *sectionEnd = findValue(strBegin, strEnd, uni::lf);
-        uint32 sectionLength = static_cast<uint32>(sectionEnd - strBegin);
-        if (sectionLength) {
-            if (reduceLeftActiveItems(sectionLength)) {
-                itemText.reserve_back(sectionLength);
-                Item &backItem = activeItems.back();
-                // Begin of exception-atomic update.  Only new(itemPool) can throw an exception here,
-                // in which case nothing is updated.
-                if (backItem.hasKind(Item::text))
-                    backItem.length += sectionLength;
-                else
-                    activeItems.push_back(*new(itemPool) Item(Item::text, sectionLength));
-                rightSerialPos += sectionLength;
-                itemText.fast_append(strBegin, sectionEnd);
-                // End of exception-atomic update.
-            } else {
-                ASSERT(!itemStack && !activeItems && !itemText && leftSerialPos == rightSerialPos);
-                outputPos += sectionLength;
-                printString(outputFormatter, strBegin, sectionEnd);
-            }
-            strBegin = sectionEnd;
-            if (strBegin == strEnd)
-                break;
-        }
-        requiredBreak();
-        ++strBegin;
-    }
-}
-
-
-// Write a required line break.
-//
-// If this method throws an exception, it may have emitted partial output but
-// leaves the PrettyPrinter in a consistent state.
-void JS::PrettyPrinter::requiredBreak()
-{
-    reduceRightActiveItems();
-    reduceLeftActiveItems(infiniteLength);
-    ASSERT(!itemStack && !activeItems && !itemText && leftSerialPos == rightSerialPos);
-    outputBreak(false, 0);
-}
-
-
-// If required is true, write a required line break; otherwise write a linear
-// line break of the given width.
-//
-// If this method throws an exception, it may have emitted partial output but
-// leaves the PrettyPrinter in a consistent state.
-void JS::PrettyPrinter::linearBreak(uint32 nSpaces, bool required)
-{
-    if (required)
-        requiredBreak();
-    else
-        linearBreak(nSpaces);
-}
-
-
-// Flush any saved output in the PrettyPrinter to the output.  Call this just
-// before destroying the PrettyPrinter.  All Indent and Block objects must have
-// been exited already.
-//
-// If this method throws an exception, it may have emitted partial output but
-// leaves the PrettyPrinter in a consistent state.
-void JS::PrettyPrinter::end()
-{
-    ASSERT(!topRegion);
-    reduceRightActiveItems();
-    reduceLeftActiveItems(infiniteLength);
-    ASSERT(!savedBlocks && !itemStack && !activeItems && !itemText && rightSerialPos == leftSerialPos && !margin);
-}

mozilla/js2/src/formatter.h

@@ -1,320 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s):
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef formatter_h___
-#define formatter_h___
-
-#include <cstdio>
-#include <cstdarg>
-
-#include "systemtypes.h"
-#include "utilities.h"
-#include "stlcfg.h"
-#include "ds.h"
-#include "strings.h"
-
-namespace JavaScript
-{
-//
-// Output
-//
-
-    // Print the characters between begin and end to the given file.  These
-    // characters may include nulls.
-    size_t printChars(FILE *file, const char *begin, const char *end);
-
-#ifndef XP_MAC_MPW
-    inline size_t printChars(FILE *file, const char *begin, const char *end) {
-        ASSERT(end >= begin);
-        return STD::fwrite(begin, 1, toSize_t(end - begin), file);
-    }
-#endif
-
-
-    // A Formatter is an abstract base class representing a simplified output stream.
-    // One can print text to a Formatter by using << and the various global
-    // print... methods below. Formatters accept both char and char16 text and
-    // convert as appropriate to their actual stream.
-    class Formatter {
-      protected:
-        virtual void printChar8(char ch);
-        virtual void printChar16(char16 ch);
-        virtual void printZStr8(const char *str);
-        virtual void printStr8(const char *strBegin, const char *strEnd) = 0;
-        virtual void printStr16(const char16 *strBegin, const char16 *strEnd) = 0;
-        virtual void printString16(const String &s);
-        virtual void printVFormat8(const char *format, va_list args);
-      public:
-
-#ifdef __GNUC__ // Workaround for gcc pedantry.  No one should be calling delete on a raw Formatter.
-        virtual ~Formatter() {}
-#endif
-
-        Formatter &operator<<(char ch) {printChar8(ch); return *this;}
-        Formatter &operator<<(char16 ch) {printChar16(ch); return *this;}
-        Formatter &operator<<(const char *str) {printZStr8(str); return *this;}
-        Formatter &operator<<(const String &s) {printString16(s); return *this;}
-        Formatter &operator<<(bool b);
-        Formatter &operator<<(uint8 i) {printFormat(*this, "%u", i); return *this;}
-        Formatter &operator<<(uint32 i) {printFormat(*this, "%u", i); return *this;}
-        Formatter &operator<<(int32 i) {printFormat(*this, "%d", i); return *this;}
-
-#ifndef _WIN32
-        // Cause compile-time undefined YOU_TRIED_TO_PRINT_A_RAW_POINTER identifier errors for accidental printing of pointers.
-        // The error occurs at the place where you try to instantiate this template; the compiler may or may not tell you where it is.
-        template<class T> Formatter &operator<<(const T *s) {YOU_TRIED_TO_PRINT_A_RAW_POINTER(s); return *this;}
-#endif
-
-        friend void printString(Formatter &f, const char *strBegin, const char *strEnd) {f.printStr8(strBegin, strEnd);}
-        friend void printString(Formatter &f, const char16 *strBegin, const char16 *strEnd) {f.printStr16(strBegin, strEnd);}
-        friend void printFormat(Formatter &f, const char *format, ...);
-    };
-
-    void printNum(Formatter &f, uint32 i, int nDigits, char pad, const char *format);
-    void printChar(Formatter &f, char ch, int count);
-    void printChar(Formatter &f, char16 ch, int count);
-    inline void printDec(Formatter &f, int32 i, int nDigits = 0, char pad = ' ') {printNum(f, (uint32)i, nDigits, pad, "%i");}
-    inline void printDec(Formatter &f, uint32 i, int nDigits = 0, char pad = ' ') {printNum(f, i, nDigits, pad, "%u");}
-    inline void printHex(Formatter &f, int32 i, int nDigits = 0, char pad = '0') {printNum(f, (uint32)i, nDigits, pad, "%X");}
-    inline void printHex(Formatter &f, uint32 i, int nDigits = 0, char pad = '0') {printNum(f, i, nDigits, pad, "%X");}
-    void printPtr(Formatter &f, void *p);
-
-
-    // An AsciiFileFormatter is a Formatter that prints to a standard ASCII
-    // file or stream. Characters with Unicode values of 256 or higher are
-    // converted to escape sequences. Selected lower characters can also be
-    // converted to escape sequences; these are specified by set bits in the
-    // BitSet passed to the constructor.
-    class AsciiFileFormatter: public Formatter {
-        FILE *file;
-        BitSet<256> filter; // Set of first 256 characters that are to be converted to escape sequences
-        bool filterEmpty;   // True if filter passes all 256 characters
-      public:
-        static BitSet<256> defaultFilter;  // Default value of filter when not given in the constructor
-
-        explicit AsciiFileFormatter(FILE *file, BitSet<256> *filter = 0);
-
-      private:
-        bool filterChar(char ch) {return filter[static_cast<uchar>(ch)];}
-        bool filterChar(char16 ch) {
-            return char16Value(ch) >= 0x100 || filter[char16Value(ch)];
-        }
-
-      protected:
-        void printChar8(char ch);
-        void printChar16(char16 ch);
-        void printZStr8(const char *str);
-        void printStr8(const char *strBegin, const char *strEnd);
-        void printStr16(const char16 *strBegin, const char16 *strEnd);
-    };
-
-    extern AsciiFileFormatter stdOut;
-    extern AsciiFileFormatter stdErr;
-
-
-    // A StringFormatter is a Formatter that prints to a String.
-    class StringFormatter: public Formatter {
-        String s;
-
-      public:
-        const String& getString() { return s; }
-        void clear() {JavaScript::clear(s);}
-      protected:
-        void printChar8(char ch);
-        void printChar16(char16 ch);
-        void printZStr8(const char *str);
-        void printStr8(const char *strBegin, const char *strEnd);
-        void printStr16(const char16 *strBegin, const char16 *strEnd);
-        void printString16(const String &str);
-    };
-
-
-//
-// Formatted Output
-//
-
-    class PrettyPrinter: public Formatter {
-      public:
-        STATIC_CONST(uint32, unlimitedLineWidth = 0x7FFFFFFF);
-        class Region;
-        class Indent;
-        class Block;
-
-      private:
-        STATIC_CONST(uint32, infiniteLength = 0x80000000);
-        const uint32 lineWidth;         // Current maximum desired line width
-
-        struct BlockInfo {
-            uint32 margin;              // Saved margin before this block's beginning
-            uint32 lastBreak;           // Saved lastBreak before this block's beginning
-            bool fits;                  // True if this entire block fits on one line
-        };
-
-        // Variables for the back end that prints to the destination
-        Formatter &outputFormatter;     // Destination formatter on which the result should be printed
-        uint32 outputPos;               // Number of characters printed on current output line
-        uint32 lineNum;                 // Serial number of current line
-        uint32 lastBreak;               // Number of line just after the last break that occurred in this block
-        uint32 margin;                  // Current left margin in spaces
-        ArrayBuffer<BlockInfo, 20> savedBlocks; // Stack of saved information about partially printed blocks
-
-        // Variables for the front end that calculates block sizes
-        struct Item: ListQueueEntry {
-            enum Kind {text, blockBegin, indentBlockBegin, blockEnd, indent, linearBreak, fillBreak};
-
-            const Kind kind;            // The kind of this text sequence
-            bool lengthKnown;           // True if totalLength is known; always true for text, blockEnd, and indent Items
-            uint32 length;              // Length of this text sequence, number of spaces for this break, or delta for indent or indentBlockBegin
-            uint32 totalLength;         // Total length of this block (for blockBegin) or length of this break plus following clump (for breaks);
-                                        // If lengthKnown is false, this is the serialPos of this Item instead of a length
-            bool hasKind(Kind k) const {return kind == k;}
-
-            explicit Item(Kind kind): kind(kind), lengthKnown(true) {}
-            Item(Kind kind, uint32 length): kind(kind), lengthKnown(true), length(length) {}
-            Item(Kind kind, uint32 length, uint32 beginSerialPos):
-                    kind(kind), lengthKnown(false), length(length), totalLength(beginSerialPos) {}
-
-            void computeTotalLength(uint32 endSerialPos) {
-                ASSERT(!lengthKnown);
-                lengthKnown = true;
-                totalLength = endSerialPos - totalLength;
-            }
-
-        };
-
-#ifdef DEBUG
-        Region *topRegion;              // Most deeply nested Region
-#endif
-        uint32 nNestedBlocks;           // Number of nested Blocks
-
-        uint32 leftSerialPos;           // The difference rightSerialPos-
-        uint32 rightSerialPos;          // leftSerialPos is always the number of characters that would be output by
-                                        // printing activeItems if they all fit on one line; only the difference
-                                        // matters -- the absolute values are irrelevant and may wrap around 2^32.
-
-        ArrayQueue<Item *, 20> itemStack; // Stack of enclosing nested Items whose lengths have not yet been determined;
-                                        // itemStack always has room for at least nNestedBlocks extra entries so that end Items
-                                        // may be added without throwing an exception.
-        Pool<Item> itemPool;            // Pool from which to allocate activeItems
-        ListQueue<Item> activeItems;    // Queue of items left to be printed
-        ArrayQueue<char16, 256> itemText; // Text of text items in activeItems, in the same order as in activeItems
-
-      public:
-        static uint32 defaultLineWidth; // Default for lineWidth if not given to the constructor
-
-        explicit PrettyPrinter(Formatter &f, uint32 lineWidth = defaultLineWidth);
-      private:
-        PrettyPrinter(const PrettyPrinter&);    // No copy constructor
-        void operator=(const PrettyPrinter&);   // No assignment operator
-      public:
-        virtual ~PrettyPrinter();
-
-      private:
-        void outputBreak(bool sameLine, uint32 nSpaces);
-        bool reduceLeftActiveItems(uint32 rightOffset);
-        void reduceRightActiveItems();
-
-        Item &beginIndent(int32 offset);
-        void endIndent(Item &i);
-
-        Item &beginBlock(Item::Kind kind, int32 offset);
-        void endBlock(Item &i);
-
-        void conditionalBreak(uint32 nSpaces, Item::Kind kind);
-
-      protected:
-        void printStr8(const char *strBegin, const char *strEnd);
-        void printStr16(const char16 *strBegin, const char16 *strEnd);
-      public:
-
-        void requiredBreak();
-        void linearBreak(uint32 nSpaces) {conditionalBreak(nSpaces, Item::linearBreak);}
-        void linearBreak(uint32 nSpaces, bool required);
-        void fillBreak(uint32 nSpaces) {conditionalBreak(nSpaces, Item::fillBreak);}
-
-        void end();
-
-        friend class Region;
-        friend class Indent;
-        friend class Block;
-
-        class Region {
-#ifdef DEBUG
-            Region *next;  // Link to next most deeply nested Region
-#endif
-          protected:
-            PrettyPrinter &pp;
-
-            Region(PrettyPrinter &pp): pp(pp) {DEBUG_ONLY(next = pp.topRegion; pp.topRegion = this;);}
-          private:
-            Region(const Region&);          // No copy constructor
-            void operator=(const Region&);  // No assignment operator
-          protected:
-#ifdef DEBUG
-            ~Region() {pp.topRegion = next;}
-#endif
-        };
-
-        // Use an Indent object to temporarily indent a PrettyPrinter by the
-        // offset given to the Indent's constructor. The PrettyPrinter's margin
-        // is set back to its original value when the Indent object is destroyed.
-        // Using an Indent object is exception-safe; no matter how control
-        // leaves an Indent scope, the indent is undone.
-        // Scopes of Indent and Block objects must be properly nested.
-        class Indent: public Region {
-            Item &endItem;              // The Item returned by beginIndent
-          public:
-            Indent(PrettyPrinter &pp, int32 offset): Region(pp), endItem(pp.beginIndent(offset)) {}
-            ~Indent() {pp.endIndent(endItem);}
-        };
-
-        // Use a Block object to temporarily enter a PrettyPrinter block.  If an
-        // offset is provided, line breaks inside the block are indented by that
-        // offset relative to the existing indent; otherwise, line breaks inside
-        // the block are indented to the current output position.  The block
-        // lasts until the Block object is destroyed.
-        // Scopes of Indent and Block objects must be properly nested.
-        class Block: public Region {
-            Item &endItem;              // The Item returned by beginBlock
-          public:
-            explicit Block(PrettyPrinter &pp): Region(pp), endItem(pp.beginBlock(Item::blockBegin, 0)) {}
-            Block(PrettyPrinter &pp, int32 offset): Region(pp), endItem(pp.beginBlock(Item::indentBlockBegin, offset)) {}
-            ~Block() {pp.endBlock(endItem);}
-        };
-    };
-
-
-    void escapeString(Formatter &f, const char16 *begin, const char16 *end, char16 quote);
-    void quoteString(Formatter &f, const String &s, char16 quote);
-}
-#endif /* formatter_h___ */

mozilla/js2/src/gc_allocator.cpp

@@ -1,151 +0,0 @@
-// -*- Mode: C++; tab-width: 4; indent-tabs-mode: t; c-basic-offset: 4 -*-
-//
-// The contents of this file are subject to the Netscape Public
-// License Version 1.1 (the "License"); you may not use this file
-// except in compliance with the License. You may obtain a copy of
-// the License at http://www.mozilla.org/NPL/
-//
-// Software distributed under the License is distributed on an "AS
-// IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
-// implied. See the License for the specific language governing
-// rights and limitations under the License.
-//
-// The Original Code is the JavaScript 2 Prototype.
-//
-// The Initial Developer of the Original Code is Netscape
-// Communications Corporation.  Portions created by Netscape are
-// Copyright (C) 2000 Netscape Communications Corporation. All
-// Rights Reserved.
-
-#include <iostream>
-#include <string>
-#include <vector>
-#include <algorithm>
-
-#include "stlcfg.h"
-#include "gc_allocator.h"
-#include "gc_container.h"
-
-/*
-namespace JavaScript {
-
-template <class T>
-typename gc_allocator<T>::pointer
-gc_allocator<T>::allocate(gc_allocator<T>::size_type n, const void*)
-{
-	return static_cast<pointer>(GC_malloc(n*sizeof(T)));
-}
-
-template <class T>
-void gc_allocator<T>::deallocate(gc_allocator<T>::pointer ptr, gc_allocator<T>::size_type)
-{
-	// this can really be a NO-OP with the GC.
-	// ::GC_free(static_cast<void*>(ptr));
-}
-
-}
- */
-
-// test driver for standalone GC development.
-
-namespace JS = JavaScript;
-
-template <class T>
-void* operator new(std::size_t, const JS::gc_allocator<T>& alloc)
-{
-	return alloc.allocate(1);
-}
-
-/**
- * Define a C++ class that is garbage collectable, and wants to have its destructor
- * called when it is finalized.
- */
-class A {
-public:
-	typedef JS::gc_traits_finalizable<A> traits;
-	typedef JS::gc_allocator<A, traits> allocator;
-	friend struct traits;
-	
-	static int instances;
-	
-	void* operator new(std::size_t)
-	{
-		return allocator::allocate(1);
-	}
-	
-	A()
-	{
-		++instances;
-		std::cout << "A::A() here." << std::endl;
-	}
-
-protected:	
-	~A()
-	{
-		--instances;
-		std::cout << "A::~A() here." << std::endl;
-	}
-
-private:
-	// void operator delete(void*) {}
-};
-
-int A::instances = 0;
-
-int main(int /* argc */, char* /* argv[] */)
-{
-	using namespace std;
-	using namespace JS;
-
-	cout << "testing the GC allocator." << endl;
-
-#ifdef XP_MAC
-	// allocate a string, using the GC, and owned by an auto_ptr, that knows how to correctly destroy the string.
-	typedef gc_container<char>::string char_string;
-	typedef gc_allocator<char_string> char_string_alloc;
-	auto_ptr<char_string, char_string_alloc> ptr(new(char_string_alloc()) char_string("This is a garbage collectable string."));
-	const char_string& str = *ptr;
-	cout << str << endl;
-#endif
-	
-	// question, how can we partially evaluate a template?
-	// can we say, typedef template <class T> vector<typename T>.
-	// typedef vector<int, gc_allocator<int> > int_vector;
-	typedef gc_container<int>::vector int_vector;
-	
-	// generate 1000 random values.
-	int_vector values;
-	for (int i = 0; i < 1000; ++i) {
-		int value = rand() % 32767;
-		values.push_back(value);
-		// allocate a random amount of garbage.
-		if (!GC_malloc(toSize_t(value)))
-			cerr << "GC_malloc failed." << endl;
-		// allocate an object that has a finalizer to call its destructor.
-		A* a = new A();
-	}
-
-	// run a collection.
-	// gc_allocator<void>::collect();
-	GC_gcollect();
-
-	// print out instance count.
-	cout << "A::instances = " << A::instances << endl;
-	
-	// sort the values.
-	sort(values.begin(), values.end());
-	
-	// print the values.
-	int_vector::iterator iter = values.begin(), last = values.end();
-	cout << *iter++;
-	while (iter < last)
-		cout << ' ' << *iter++;
-	cout << endl;
-
-#ifdef XP_MAC	
-	// finally, print the string again.
-	cout << str << endl;
-#endif
-
-	return 0;
-}

mozilla/js2/src/gc_allocator.h

@@ -1,214 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef gc_allocator_h
-#define gc_allocator_h
-
-#include <memory>
-
-// Microsoft VC6 bug: standard identifiers should be in std namespace
-#ifndef _WIN32
-using std::size_t;
-using std::ptrdiff_t;
-#endif
-
-namespace JavaScript {
-    extern "C" {
-        void* GC_malloc(size_t bytes);
-        void* GC_malloc_atomic(size_t bytes);
-        void GC_free(void* ptr);
-        void GC_gcollect(void);
-
-        typedef void (*GC_finalization_proc) (void* obj, void* client_data);
-        void GC_register_finalizer(void* obj, GC_finalization_proc proc,
-                                   void* client_data,
-                                   GC_finalization_proc *old_proc,
-                                   void* *old_client_data);
-    }
-
-#if 0 && !defined(XP_MAC)
-    // for platforms where GC doesn't exist yet.
-    inline void* GC_malloc(size_t bytes) { return ::operator new(bytes); }
-    inline void* GC_malloc_atomic(size_t bytes) { return ::operator new(bytes); }
-    inline void GC_free(void* ptr) { operator delete(ptr); }
-    inline void GC_gcollect() {}
-    inline void GC_register_finalizer(void* obj, GC_finalization_proc proc,
-                                      void* client_data,
-                                      GC_finalization_proc *old_proc,
-                                      void* *old_client_data) {}
-#endif
-    
-    /**
-     * General case:  memory for type must be allocated as a conservatively
-     * scanned block of memory.
-     */
-    template <class T> struct gc_traits {
-        static T* allocate(size_t n) {
-            return static_cast<T*>(GC_malloc(n * sizeof(T)));
-        }
-    };
-    
-    /**
-     * Specializations for blocks of atomic types:  the macro define_atomic_type(_type)
-     * specializes gc_traits<T> for types that need not be scanned by the
-     * GC. Implementors are free to define other types as atomic, if they are
-     * guaranteed not to contain pointers.
-     */
-#define define_atomic_type(_type)                                               \
-    template <> struct gc_traits<_type> {                                       \
-        static _type* allocate(size_t n)                                        \
-        {                                                                       \
-            return static_cast<_type*>(GC_malloc_atomic(n * sizeof(_type)));    \
-        }                                                                       \
-    };
-    
-    define_atomic_type(char)
-    define_atomic_type(unsigned char)
-    define_atomic_type(short)
-    define_atomic_type(unsigned short)
-    define_atomic_type(int)
-    define_atomic_type(unsigned int)
-    define_atomic_type(long)
-    define_atomic_type(unsigned long)
-    define_atomic_type(float)
-    define_atomic_type(double)
-    
-    #undef define_atomic_type
-    
-    /**
-     * Traits for classes that need to have their destructor called
-     * when reclaimed by the garbage collector.
-     */
-    template <class T> struct gc_traits_finalizable {
-        static void finalizer(void* obj, void* client_data)
-        {
-            T* t = static_cast<T*>(obj);
-            size_t n = reinterpret_cast<size_t>(client_data);
-            for (size_t i = 0; i < n; ++i)
-                t[i].~T();
-        }
-        
-        static T* allocate(size_t n)
-        {
-            T* t = gc_traits<T>::allocate(n);
-            GC_finalization_proc old_proc; void* old_client_data;
-            GC_register_finalizer(t, &finalizer, reinterpret_cast<void*>(n),
-                                  &old_proc, &old_client_data);
-            return t;
-        }
-    };
-    
-    /**
-     * An allocator that can be used to allocate objects in the garbage
-     * collected heap.
-     */
-    template <class T, class traits = gc_traits<T> > class gc_allocator {
-    public:
-        typedef T value_type;
-        typedef size_t size_type;
-        typedef ptrdiff_t difference_type;
-        typedef T *pointer;
-        typedef const T *const_pointer;
-        typedef T &reference;
-        typedef const T &const_reference;
-        
-        gc_allocator() {}
-        template<typename U, typename UTraits>
-        gc_allocator(const gc_allocator<U, UTraits>&) {}
-        // ~gc_allocator() {}
-
-        static pointer address(reference r) { return &r; }
-        static const_pointer address(const_reference r) { return &r; }
-                
-        static pointer allocate(size_type n, const void* /* hint */ = 0) {
-            return traits::allocate(n);
-        }
-        static void deallocate(pointer, size_type) {}
-        
-        static void construct(pointer p, const T &val) { new(p) T(val);}
-        static void destroy(pointer p) { p->~T(); }
-        
-#if defined(__GNUC__) || defined(_WIN32)
-        static size_type max_size() { return size_type(-1) / sizeof(T); }
-#else
-        static size_type max_size() {
-            return std::numeric_limits<size_type>::max() / sizeof(T);
-        }
-#endif
-
-        template<class U> struct rebind { typedef gc_allocator<U> other; };
-
-#ifdef _WIN32
-        // raw byte allocator used on some platforms (grrr).
-        typedef char _Char[1];
-        static char* _Charalloc(size_type n) {
-            return (char*) rebind<_Char>::other::allocate(n);
-        }
-
-        /**
-         * funky operator required for calling basic_string<T> constructor
-         * (grrr).
-         */
-        template<typename U, typename UTraits>
-        int operator==(const gc_allocator<U, UTraits>&) { return 0; }
-#endif
-
-        // void* deallocate used on some platforms (grrr).
-        static void deallocate(void*, size_type) {}
-
-        static void collect() { GC_gcollect(); }
-    };
-
-    /**
-     * Generic base class for objects allocated using a gc_allocator. How they
-     * are allocated can be controlled by specializing gc_traits for the
-     * specific class.
-     */
-    template <typename T> class gc_object {
-    public:
-        void* operator new(size_t) { return gc_allocator<T>::allocate(1, 0); }
-        void operator delete(void* /* ptr */) {}
-    };
-
-    /**
-     * Simpler base class for classes that have no need to specialize allocation
-     * behavior.
-     */
-    class gc_base {
-    public:
-        void* operator new(size_t n) { return GC_malloc(n); }
-        void operator delete(void*) {}
-    };
-}
-
-#endif /* gc_allocator_h */

mozilla/js2/src/gc_container.h

@@ -1,85 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef gc_container_h
-#define gc_container_h
-
-#include "gc_allocator.h"
-
-#include <list>
-#include <vector>
-#include <string>
-
-#define LIST std::list
-#define VECTOR std::vector
-
-#if defined(__GNUC__)
-// grr, what kind of standard is this?
-#define STRING basic_string
-#define CHAR_TRAITS string_char_traits
-#else
-#define STRING std::basic_string
-#define CHAR_TRAITS std::char_traits
-#endif
-
-namespace JavaScript {
-    /**
-     * Rebind some of the basic container types to use a GC_allocator.
-     * What I really want is something more general, something like:
-     * template <typename Container, typename T> class gc_rebind {
-     *   typedef typename Container<T, gc_allocator<T> > other;
-     * };
-     * But I can't figure out how to do that with C++ templates.
-     */
-    template <class T> struct gc_container {
-        typedef typename LIST<T, gc_allocator<T> > list;
-        typedef typename VECTOR<T, gc_allocator<T> > vector;
-        typedef typename STRING<T, CHAR_TRAITS<T>, gc_allocator<T> > string;
-    };
-
-    /**
-     * But, it's pretty easy to do with macros:
-     */
-    #define GC_CONTAINER(container, type) container<T, gc_allocator<T> >
-    
-    /*
-    // this gives an "unimplemented C++ feature" error using CWPro5.
-    // maybe someday.
-    template <template<class, class> typename Container, typename T>
-    struct gc_rebind {
-        typedef typename Container<T, gc_allocator<T> > container;
-    };
-    */
-}
-
-#endif /* gc_container_h */

mozilla/js2/src/hash.cpp

@@ -1,185 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#include "hash.h"
-#include <new>
-
-namespace JS = JavaScript;
-
-
-//
-// Hash Codes
-//
-
-
-// General-purpose null-terminated C string hash function
-JS::HashNumber JS::hashString(const char *s)
-{
-    HashNumber h = 0;
-    uchar ch;
-    
-    while ((ch = (uchar)*s++) != 0)
-        h = (h >> 28) ^ (h << 4) ^ ch;
-    return h;
-}
-
-// General-purpose String hash function
-JS::HashNumber JS::hashString(const String &s)
-{
-    HashNumber h = 0;
-    String::const_iterator p = s.begin();
-    String::size_type n = s.size();
-    
-    if (n < 16)
-        // Hash every character in a short string.
-        while (n--)
-            h = (h >> 28) ^ (h << 4) ^ *p++;
-    else
-        // Sample a la java.lang.String.hash().
-        for (String::size_type m = n / 8; n >= m; p += m, n -= m)
-            h = (h >> 28) ^ (h << 4) ^ *p;
-    return h;
-}
-
-
-//
-// Hash Tables
-//
-
-const uint minLgNBuckets = 4;
-
-JS::GenericHashTableIterator::GenericHashTableIterator(GenericHashTable &ht):
-        ht(ht), entry(0), nextBucket(ht.buckets)
-{
-    DEBUG_ONLY(++ht.nReferences);
-    operator++();
-}
-
-
-
-JS::GenericHashTableIterator &JS::GenericHashTableIterator::operator++()
-{
-    GenericHashEntry *e = entry;
-
-    if (e) {
-        backpointer = &e->next;
-        e = e->next;
-    }
-    if (!e) {
-        GenericHashEntry **const bucketsEnd = ht.bucketsEnd;
-        GenericHashEntry **bucket = nextBucket;
-
-        while (bucket != bucketsEnd) {
-            e = *bucket++;
-            if (e) {
-                backpointer = bucket-1;
-                break;
-            }
-        }
-        nextBucket = bucket;
-    }
-    entry = e;
-    return *this;
-}
-
-
-JS::GenericHashTable::GenericHashTable(uint32 nEntriesDefault):
-        nEntries(0)
-{
-    DEBUG_ONLY(nReferences = 0);
-
-    uint lgNBuckets = ceilingLog2(nEntriesDefault);
-    if (lgNBuckets < minLgNBuckets)
-        lgNBuckets = minLgNBuckets;
-    defaultLgNBuckets = lgNBuckets;
-
-    recomputeMinMaxNEntries(lgNBuckets);
-    uint32 nBuckets = JS_BIT(lgNBuckets);
-    buckets = new GenericHashEntry*[nBuckets];
-    // No exceptions after this point unless buckets is deleted.
-
-    bucketsEnd = buckets + nBuckets;
-    zero(buckets, bucketsEnd);
-}
-
-
-// Initialize shift, minNEntries, and maxNEntries based on the lg2 of the
-// number of buckets.
-void JS::GenericHashTable::recomputeMinMaxNEntries(uint lgNBuckets)
-{
-    uint32 nBuckets = JS_BIT(lgNBuckets);
-    shift = 32 - lgNBuckets;
-    maxNEntries = nBuckets;   // Maximum ratio is 100%
-    // Minimum ratio is 37.5%
-    minNEntries = lgNBuckets <= defaultLgNBuckets ? 0 : 3*(nBuckets>>3);
-}
-
-
-// Rehash the table.  This method cannot throw out-of-memory exceptions, so it is
-// safe to call from a destructor.
-void JS::GenericHashTable::rehash()
-{
-    uint32 newLgNBuckets = ceilingLog2(nEntries);
-    if (newLgNBuckets < defaultLgNBuckets)
-        newLgNBuckets = defaultLgNBuckets;
-    uint32 newNBuckets = JS_BIT(newLgNBuckets);
-    try {
-        GenericHashEntry **newBuckets = new GenericHashEntry*[newNBuckets];
-        // No exceptions after this point.
-
-        GenericHashEntry **newBucketsEnd = newBuckets + newNBuckets;
-        zero(newBuckets, newBucketsEnd);
-        recomputeMinMaxNEntries(newLgNBuckets);
-        GenericHashEntry **be = bucketsEnd;
-        for (GenericHashEntry **b = buckets; b != be; b++) {
-            GenericHashEntry *e = *b;
-            while (e) {
-                GenericHashEntry *next = e->next;
-                // Place e in the new set of buckets.
-                GenericHashEntry **nb = newBuckets + (e->keyHash*goldenRatio >> shift);
-                e->next = *nb;
-                *nb = e;
-                e = next;
-            }
-        }
-        delete[] buckets;
-        buckets = newBuckets;
-        bucketsEnd = newBucketsEnd;
-    } catch (std::bad_alloc) {
-        // Out of memory.  Ignore the error and just relax the resizing boundaries.
-        if (buckets + JS_BIT(newLgNBuckets) > bucketsEnd)
-            maxNEntries >>= 1;
-        else
-            minNEntries <<= 1;
-    }
-}

mozilla/js2/src/hash.h

@@ -1,402 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef hash_h___
-#define hash_h___
-
-#include "systemtypes.h"
-#include "utilities.h"
-#include "strings.h"
-#include "algo.h"
-
-namespace JavaScript {
-
-//
-// Hash Codes
-//
-
-    typedef uint32 HashNumber;
-
-    HashNumber hashString(const char *s);
-    HashNumber hashString(const String &s);
-
-    template<class Key>
-    struct Hash {
-        HashNumber operator()(Key key) const;
-    };
-
-    template<class Key>
-    inline HashNumber Hash<Key>::operator()(Key key) const
-    {
-        return hashString(key);
-    }
-
-    const HashNumber goldenRatio = 0x9E3779B9U;
-
-
-//
-// Private
-//
-
-    // Base class for user-defined hash entries.
-    // private
-    class GenericHashEntry {
-    public:
-        GenericHashEntry *next;         // Link to next entry in the same bucket
-        const HashNumber keyHash;       // This entry's hash value
-
-    protected:
-        explicit GenericHashEntry(HashNumber keyHash): next(0), keyHash(keyHash) {}
-
-        friend class GenericHashTable;
-    };
-
-
-    // private
-    class GenericHashTableIterator;
-    class GenericHashTable {
-      protected:
-        GenericHashEntry **buckets;     // Vector of hash buckets
-        GenericHashEntry **bucketsEnd;  // Pointer past end of vector of hash buckets
-        uint defaultLgNBuckets;         // lg2 of minimum number of buckets for which to size the table
-        uint32 nEntries;                // Number of entries in table
-        uint32 minNEntries;             // Minimum number of entries without rehashing
-        uint32 maxNEntries;             // Maximum number of entries without rehashing
-        uint32 shift;                   // 32 - lg2(number of buckets)
-#ifdef DEBUG
-      public:
-        uint32 nReferences;             // Number of iterators and references
-                                        // currently pointing to this hash table
-#endif
-
-      public:
-        explicit GenericHashTable(uint32 nEntriesDefault);
-        ~GenericHashTable() {
-#ifndef _WIN32
-            ASSERT(nReferences == 0);
-#endif
-            delete[] buckets;
-        }
-
-        void recomputeMinMaxNEntries(uint lgNBuckets);
-        void rehash();
-        void maybeGrow() {if (nEntries > maxNEntries) rehash();}
-        void maybeShrink() {if (nEntries < minNEntries) rehash();}
-        
-        friend class GenericHashTableIterator;
-
-        typedef GenericHashTableIterator Iterator;
-    };
-
-
-    // This ought to be GenericHashTable::Iterator, but this doesn't work
-    // due to a Microsoft VC6 bug.
-    class GenericHashTableIterator {
-      protected:
-        GenericHashTable &ht;           // Hash table being iterated
-        GenericHashEntry *entry;        // Current entry; nil if done
-        GenericHashEntry **backpointer; // Pointer to pointer to current entry
-        GenericHashEntry **nextBucket;  // Next bucket; pointer past end of vector of hash buckets if done
-    public:
-        explicit GenericHashTableIterator(GenericHashTable &ht);
-        ~GenericHashTableIterator() {ht.maybeShrink(); DEBUG_ONLY(--ht.nReferences);}
-
-        // Return true if there are entries left.
-        operator bool() const {return entry != 0;}
-        
-        GenericHashTableIterator &operator++();
-    };
-
-
-//
-// Hash Tables
-//
-
-    template<class Data, class Key, class H = Hash<Key> >
-    class HashTable: private GenericHashTable {
-        H hasher; // Hash function
-
-        struct Entry: public GenericHashEntry {
-            Data data;
-            
-            Entry(HashNumber keyHash, Key key): GenericHashEntry(keyHash), data(key) {}
-            template<class Value>
-            Entry(HashNumber keyHash, Key key, Value value): GenericHashEntry(keyHash), data(key, value) {}
-        };
-
-      public:
-        class Reference {
-#ifdef _WIN32
-        // Microsoft VC6 bug: friend declarations to inner classes don't work
-          public:
-#endif
-            Entry *entry;                   // Current entry; nil if done
-            GenericHashEntry **backpointer; // Pointer to pointer to current entry
-            const HashNumber keyHash;       // This entry's key's hash value
-#ifdef DEBUG
-            GenericHashTable *ht;           // Hash table to which this Reference points
-#endif
-
-          public:
-#ifndef _WIN32
-            Reference(HashTable &ht, Key key);  // Search for an entry with the given key.
-#else
-            // Microsoft VC6 bug: VC6 doesn't allow this to be defined outside the class
-            Reference(HashTable &ht, Key key): keyHash(ht.hasher(key)) {
-#ifdef DEBUG
-                Reference::ht = &ht;
-                ++ht.nReferences;
-#endif
-                HashNumber kh = keyHash;
-                HashNumber h = kh*goldenRatio >> ht.shift;
-                GenericHashEntry **bp = ht.buckets + h;
-                Entry *e;
-
-                while ((e = static_cast<Entry *>(*bp)) != 0 && !(e->keyHash == kh && e->data == key))
-                    bp = &e->next;
-                entry = e;
-                backpointer = bp;
-            }
-#endif
-          private:
-            Reference(const Reference&);        // No copy constructor
-            void operator=(const Reference&);   // No assignment operator
-          public:
-#if defined(DEBUG) && !defined(_WIN32)
-            ~Reference() {if (ht) --ht->nReferences;}
-#endif
-
-            // Return true if an entry was found.
-            operator bool() const {return entry != 0;}
-            // Return the data of the entry that was found.
-            Data &operator*() const {ASSERT(entry); return entry->data;}
-            
-            friend class HashTable;
-        };
-
-        class Iterator: public GenericHashTableIterator {
-          public:
-            explicit Iterator(HashTable &ht): GenericHashTableIterator(ht) {}
-          private:
-            Iterator(const Iterator&);          // No copy constructor
-            void operator=(const Iterator&);    // No assignment operator
-          public:
-
-            // Go to next entry.
-            Iterator &operator++() {return *static_cast<Iterator*>(&GenericHashTableIterator::operator++());}
-            // Return current entry's data.
-            Data &operator*() const {ASSERT(entry); return static_cast<Entry *>(entry)->data;}
-            
-            void erase();
-            
-        };
-
-        HashTable(uint32 nEntriesDefault = 0, const H &hasher = H()): GenericHashTable(nEntriesDefault), hasher(hasher) {}
-        ~HashTable();
-
-        template<class Value> Data &insert(Reference &r, Key key, Value value);
-        Data &insert(Reference &r, Key key);
-        Data &insert(Key key);
-        void erase(Reference &r);
-        void erase(Key key);
-        Data *operator[](Key key);
-        
-        friend class Reference;
-        friend class Iterator;
-
-#ifndef _WIN32
-        template<class Value> Data &insert(Key key, Value value);
-#else
-        // Microsoft VC6 bug: VC6 doesn't allow this to be defined outside the
-        // class
-        template<class Value> Data &insert(Key key, Value value) {
-            Reference r(*this, key);
-            if (r)
-                return *r = value;
-            else
-                return insert(r, key, value);
-        }
-#endif
-    };
-
-
-//
-// Implementation
-//
-
-    template<class Data, class Key, class H>
-    HashTable<Data, Key, H>::~HashTable()
-    {
-        GenericHashEntry **be = bucketsEnd;
-        for (GenericHashEntry **b = buckets; b != be; b++) {
-            Entry *e = static_cast<Entry *>(*b);
-            while (e) {
-                Entry *next = static_cast<Entry *>(e->next);
-                delete e;
-                e = next;
-            }
-        }
-    }
-
-
-#ifndef _WIN32
-    template<class Data, class Key, class H>
-    HashTable<Data, Key, H>::Reference::Reference(HashTable &ht, Key key):
-            keyHash(ht.hasher(key))
-    {
-#ifdef DEBUG
-        Reference::ht = &ht;
-        ++ht.nReferences;
-#endif
-        HashNumber kh = keyHash;
-        HashNumber h = kh*goldenRatio >> ht.shift;
-        GenericHashEntry **bp = ht.buckets + h;
-        Entry *e;
-
-        while ((e = static_cast<Entry *>(*bp)) != 0 &&
-               !(e->keyHash == kh && e->data == key))
-            bp = &e->next;
-        entry = e;
-        backpointer = bp;
-    }
-
-
-    // Insert the given key/value pair into the hash table.  Reference must
-    // be the result of an unsuccessful search for that key in the table.
-    // The reference is not valid after this method is called.
-    // Return a reference to the new entry's value.
-    template<class Data, class Key, class H> template<class Value>
-    inline Data &HashTable<Data, Key, H>::insert(Reference &r, Key key, Value value)
-    {
-        ASSERT(r.ht == this && !r.entry);
-        Entry *e = new Entry(r.keyHash, key, value);
-        *r.backpointer = e;
-        ++nEntries;
-        maybeGrow();
-#ifdef DEBUG
-        --r.ht->nReferences;
-        r.ht = 0;
-#endif
-        return e->data;
-    }
-#endif
-
-    // Same as above but without a Value argument.
-    template<class Data, class Key, class H>
-    inline Data &HashTable<Data, Key, H>::insert(Reference &r, Key key)
-    {
-        ASSERT(r.ht == this && !r.entry);
-        Entry *e = new Entry(r.keyHash, key);
-        *r.backpointer = e;
-        ++nEntries;
-        maybeGrow();
-#ifdef DEBUG
-        --r.ht->nReferences;
-        r.ht = 0;
-#endif
-        return e->data;
-    }
-
-
-
-    // Insert the given key/value pair into the hash table.  If an entry with a
-    // matching key already exists, replace that entry's value.
-    // Return a reference to the new entry's value.
-#ifndef _WIN32
-    // Microsoft VC6 bug: VC6 doesn't allow this to be defined outside the class
-    template<class Data, class Key, class H> template<class Value>
-    Data &HashTable<Data, Key, H>::insert(Key key, Value value)
-    {
-        Reference r(*this, key);
-        if (r)
-            return *r = value;
-        else
-            return insert(r, key, value);
-    }
-#endif
-
-    // Same as above but without a Value argument.
-    template<class Data, class Key, class H>
-    Data &HashTable<Data, Key, H>::insert(Key key)
-    {
-        Reference r(*this, key);
-        if (r)
-            return *r;
-        else
-            return insert(r, key);
-    }
-
-
-    // Reference r must point to an existing entry.  Delete that entry.
-    // The reference is not valid after this method is called.
-    template<class Data, class Key, class H>
-    inline void HashTable<Data, Key, H>::erase(Reference &r)
-    {
-        Entry *e = r.entry;
-        ASSERT(r.ht == this && e);
-        *r.backpointer = e->next;
-        --nEntries;
-        delete e;
-#ifdef DEBUG
-        --r.ht->nReferences;
-        r.ht = 0;
-#endif
-        maybeShrink();
-    }
-
-
-    // Remove the hash table entry, if any, matching the given key.
-    template<class Data, class Key, class H>
-    void HashTable<Data, Key, H>::erase(Key key)
-    {
-        Reference r(*this, key);
-        if (r)
-            erase(r);
-    }
-
-
-    // Return a pointer to the value of the hash table entry matching the given
-    // key.  Return nil if no entry matches.
-    template<class Data, class Key, class H>
-    Data *HashTable<Data, Key, H>::operator[](Key key)
-    {
-        Reference r(*this, key);
-        if (r)
-            return &*r;
-        else
-            return 0;
-    }
-
-}
-
-#endif

mozilla/js2/src/ica_exception.cpp

@@ -1,51 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#include "exception.h"
-
-namespace JavaScript {
-
-    extern const char* exception_types[];
-    extern const char* exception_msgs[];    
-    
-    void
-    JSException::toString8 (string8 &rval)
-    {
-        rval = string8(exception_types[mType]) + " Exception: " +
-            string8(exception_msgs[mID]);
-        if (mSource.size() != 0)
-            rval += " in " + mSource;
-    }
-    
-}
-    

mozilla/js2/src/ica_exception.h

@@ -1,115 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef exception_h___
-#define exception_h___
-#include "utilities.h"
-
-namespace JavaScript {
-
-    enum ExceptionType {
-        etUnknown = 0,
-        etLexer,
-        etParser,
-        etRuntime,
-        etCount
-    };
-    
-    enum ExceptionID {
-        eidExpectBool = 0,
-        eidExpectDouble,
-        eidExpectInt32,
-        eidExpectUInt32,
-        eidExpectRegister,
-        eidExpectArgList,
-        eidExpectColon,
-        eidExpectCloseParen,
-        eidExpectBinaryOp,
-        eidExpectString,
-        eidExpectLabel,
-        eidExpectComma,
-        eidExpectNewline,
-        eidExpectIdentifier,
-        eidDuplicateLabel,
-        eidUnknownICode,
-        eidUnknownBinaryOp,
-        eidUnterminatedString,
-        eidCount
-    };    
-    
-    class JSException {
-      public:
-        JSException (ExceptionID ID, string8_citer pos = 0,
-                     string8 source = "", ExceptionType type = etUnknown)
-            : mID(ID), mType(type), mPos(pos), mSource(source) {}        
-        ExceptionID mID;
-        ExceptionType mType;
-        string8_citer mPos;
-        string8 mSource;
-
-      public:
-        void toString8(string8 &rval);
-        /*
-      private:
-        JSException(const JSException&);
-        */
-        
-    };
-
-    class JSLexException : public JSException {
-      public:
-        JSLexException (ExceptionID ID, string8_citer pos = 0,
-                        string8 source = "") :
-                        JSException(ID, pos, source, etLexer) {}
-        /*
-      private:
-        JSLexException (const JSLexException&);
-        */
-    };
-
-    class JSParseException : public JSException {
-      public:
-        JSParseException (ExceptionID ID, string8_citer pos = 0,
-                          string8 source = "") :
-                          JSException(ID, pos, source, etParser) {}
-        /*
-      private:
-        JSParseException (const JSParseException&);
-        */
-    };
-    
-}
-
-#endif /* exception_h___ */
-
-

mozilla/js2/src/ica_test.cpp

@@ -1,235 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#include <stdio.h>
-#include <string>
-
-#include "utilities.h"
-#include "icodegenerator.h"
-#include "lexutils.h"
-#include "icodeasm.h"
-
-using namespace JavaScript;
-
-void
-testAlpha (const string8 &str, const string &expect)
-{
-    string *result;
-    LexUtils::lexAlpha (str.begin(), str.end(), &result);
-    if (*result == expect)
-        fprintf (stderr, "PASS: ");
-    else
-        fprintf (stderr, "FAIL: ");
-    fprintf (stderr, "string '%s' alpha parsed as '%s'\n", str.c_str(), 
-             result->c_str());
-}
-
-void
-testBool (const string8 &str, bool expect)
-{
-    bool b;
-    LexUtils::lexBool (str.begin(), str.end(), &b);
-    if (b == expect)
-        fprintf (stderr, "PASS: ");
-    else
-        fprintf (stderr, "FAIL: ");
-    fprintf (stderr, "string '%s' bool parsed as %i\n", str.c_str(), b);
-}
-
-void
-testDouble (const string8 &str, double expect)
-{
-    double result;
-    LexUtils::lexDouble (str.begin(), str.end(), &result);
-    if (result == expect)
-        fprintf (stderr, "PASS: ");
-    else
-        fprintf (stderr, "FAIL: ");
-    fprintf (stderr, "string '%s' double parsed as %f\n", str.c_str(), 
-             result);
-}
-
-void
-testString (const string8 &str, const string &expect)
-{
-    string *result;
-    LexUtils::lexString8 (str.begin(), str.end(), &result);
-    if (*result == expect)
-        fprintf (stderr, "PASS: ");
-    else
-        fprintf (stderr, "FAIL: ");
-    fprintf (stderr, "string '%s' string parsed as '%s'\n", str.c_str(), 
-             result->c_str());
-}
-
-void
-testUInt32 (const string8 &str, uint32 expect)
-{
-    uint32 result;
-    LexUtils::lexUInt32 (str.begin(), str.end(), &result);
-    if (result == expect)
-        fprintf (stderr, "PASS: ");
-    else
-        fprintf (stderr, "FAIL: ");
-    fprintf (stderr, "string '%s' uint32 parsed as %u\n", str.c_str(), 
-             result);
-}
-
-void
-testParse (JavaScript::ICodeASM::ICodeParser &icp,
-           JavaScript::Interpreter::Context cx,
-           const string &str)
-{
-    using namespace JavaScript;
-    
-    icp.parseSourceFromString (str);
-    ICG::ICodeModule icm = ICG::ICodeModule (icp.mInstructions,
-                                             new ICG::VariableList(),
-                                             new ICG::ParameterList(),
-                                             icp.mMaxRegister, 0,
-                                             &JSTypes::Object_Type);
-
-    stdOut << icm;
-
-    JSTypes::JSValues args;
-    cx.interpret (&icm, args);
-    
-}
-
-static JSTypes::JSValue
-print(Interpreter::Context *, const JSTypes::JSValues &argv)
-{
-    size_t n = argv.size();
-    if (n > 1) {                // the 'this' parameter is un-interesting
-        stdOut << argv[1];
-        for (size_t i = 2; i < n; ++i)
-            stdOut << ' ' << argv[i];
-    }
-    stdOut << "\n";
-    return JSTypes::kUndefinedValue;
-}
-
-int
-main (int , char **)
-{
-    World world;
-    JSTypes::JSScope global;
-    
-    global.defineNativeFunction(world.identifiers["print"], print);
-    
-    Interpreter::Context cx (world, &global);
-    ICodeASM::ICodeParser icp(&cx);
-
-    testAlpha ("False", "False");
-    testAlpha ("fe fi fo fum", "fe");
-    testAlpha ("   bla", "");
-
-    testBool ("true", true);
-    testBool ("True", true);
-    testBool ("tRue", true);
-    testBool ("TRUE", true);
-    testBool ("True", true);
-    testBool ("false", false);
-    testBool ("False", false); 
-    testBool ("fAlSe", false);
-    testBool ("FALSE", false);
-    testBool ("False", false);
-
-    testDouble ("123", 123);
-    testDouble ("12.3", 12.3);
-    testDouble ("-123", -123);
-    testDouble ("-12.3", -12.3);
-
-    testString ("\"fe fi fo fum\"", "fe fi fo fum");
-    testString ("'the tab is ->\\t<- here'", "the tab is ->\t<- here");
-    testString ("'the newline is ->\\n<- here'", "the newline is ->\n<- here");
-    testString ("'the cr is ->\\r<- here'", "the cr is ->\r<- here");
-    testString ("\"an \\\"escaped\\\" string\"", "an \"escaped\" string");
-
-    testUInt32 ("123", 123);
-    testUInt32 ("12.3", 12);
-    testUInt32 ("-123", 0);
-    testUInt32 ("-12.3", 0);
-    /* XXX what to do with the overflow? */
-    //testUInt32 (icp, "12123687213612873621873438754387934657834", 0);
-
-    string src;
-    
-    src = 
-        "some_label:\n"
-        "LOAD_STRING               R1, 'hello'   ;test comment\n"
-        "CAST                      R2, R1, 'any';another test comment\n"
-        "SAVE_NAME                 'x', R2\n"
-        "LOAD_NAME                 R1, 'x'\n"
-        "LOAD_NAME                 R2, 'print'\n"
-        "CALL                      R3, R2, <NaR>, (R1)\n"
-        "RETURN                    R3";
-    
-    testParse (icp, cx, src);
-
-    /* {x= 1;  for (i = 10; i > 0; --i) x = x * i; print ("x is " + x);} */
-    src = 
-        "LOAD_IMMEDIATE            R1, 1\n"
-        "CAST                      R2, R1, 'any'\n"
-        "SAVE_NAME                 'x', R2\n"
-        "LOAD_IMMEDIATE            R1, 10\n"
-        "CAST                      R2, R1, 'any'\n"
-        "SAVE_NAME                 'i', R2\n"
-        "BRANCH                    Offset 16\n"
-        "LOAD_NAME                 R1, 'x'\n"
-        "LOAD_NAME                 R2, 'i'\n"
-        "GENERIC_BINARY_OP         R3, Multiply, R1, R2\n"
-        "CAST                      R4, R3, 'any'\n"
-        "SAVE_NAME                 'x', R4\n"
-        "LOAD_NAME                 R1, 'i'\n"
-        "LOAD_IMMEDIATE            R2, 1\n"
-        "GENERIC_BINARY_OP         R3, Subtract, R1, R2\n"
-        "SAVE_NAME                 'i', R3\n"
-        "LOAD_NAME                 R4, 'i'\n"
-        "LOAD_IMMEDIATE            R5, 0\n"
-        "GENERIC_BINARY_OP         R6, Less, R5, R4\n"
-        "BRANCH_TRUE               Offset 7, R6\n"
-        "LOAD_STRING               R1, 'x is '\n"
-        "LOAD_NAME                 R2, 'x'\n"
-        "GENERIC_BINARY_OP         R3, Add, R1, R2\n"
-        "LOAD_NAME                 R4, 'print'\n"
-        "CALL                      R5, R4, <NaR>, (R3)\n"
-        "RETURN                    <NaR>\n";
-
-    testParse (icp, cx, src);
-
-    return 0;
-}
-
-    
-

mozilla/js2/src/icodeasm.cpp

@@ -1,549 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#include <stdio.h>
-
-#include "icodeasm.h"
-#include "icodemap.h"
-#include "utilities.h"
-#include "lexutils.h"
-#include "exception.h"
-
-namespace JavaScript {
-namespace ICodeASM {
-    using namespace LexUtils;
-    
-    static char *keyword_offset = "offset";
-    static char *keyword_exprNodeKinds[] = {"add", "subtract", "multiply", "divide",
-                                        "remainder", "leftshift", "rightshift",
-                                        "logicalrightshift", "bitwiseor",
-                                        "bitwisexor", "bitwiseand", "less",
-                                        "lessorequal", "equal", "identical", 0};
-    static ExprNode::Kind exprNodeOps[] = 
-            { ExprNode::add, ExprNode::subtract, ExprNode::multiply, ExprNode::divide, 
-              ExprNode::modulo, ExprNode::leftShift, ExprNode::rightShift, 
-              ExprNode::logicalRightShift, ExprNode::bitwiseOr,
-              ExprNode::bitwiseXor, ExprNode::bitwiseAnd, ExprNode::lessThan,
-              ExprNode::lessThanOrEqual, ExprNode::equal, ExprNode::identical }; 
-
-    void
-    ICodeParser::parseSourceFromString (const string8 &source)
-    {
-        uint statementNo = 0;
-        string8_citer begin = source.begin();
-        string8_citer end = source.end();
-
-        mInstructions = new VM::InstructionStream();
-        mMaxRegister = 0;
-        mInstructionCount = 0;
-        mLabels.clear();
-        mNamedLabels.clear();
-        
-        while (begin < end)
-        {
-            try
-            {
-                ++statementNo;
-                begin = parseNextStatement (begin, end);
-            }
-            catch (JSException &e)
-            {
-                string8 etext;
-                e.toString8(etext);
-                
-                fprintf (stderr, "%s at statement %u\n",
-                         etext.c_str(), statementNo);
-                return;
-            }
-        }
-
-        if (begin > end)
-            NOT_REACHED ("Overran source buffer!");
-    }
-
-    /**********************************************************************
-     * operand parse functions (see comment in the .h file) ... 
-     */
-
-    string8_citer
-    ICodeParser::parseArgumentListOperand (string8_citer begin,
-                                           string8_citer end,
-                                           VM::ArgumentList **rval)
-    {
-        /* parse argument list on the format "(['argname': ]register[, ...])" */
-        TokenLocation tl = seekTokenStart (begin, end);
-        VM::ArgumentList *al = new VM::ArgumentList();
-        
-        if (tl.estimate != teOpenParen)
-            throw JSParseException (eidExpectArgList);
-        
-        tl = seekTokenStart (tl.begin + 1, end);
-        StringFormatter s_fmt;
-        while (tl.estimate == teString || tl.estimate == teAlpha) {
-            string *argName = 0;
-
-            if (tl.estimate == teString) {
-                /* look for the argname in quotes */
-                begin = lexString8 (tl.begin, end, &argName);
-
-                /* look for the : */
-                tl = seekTokenStart (begin, end);
-                if (tl.estimate != teColon)
-                    throw JSParseException (eidExpectColon);
-
-                /* and now the register */
-                tl = seekTokenStart (tl.begin + 1, end);
-            }
-
-            if (tl.estimate != teAlpha)
-                throw JSParseException (eidExpectRegister);
-
-            JSTypes::Register r;
-            begin = lexRegister (tl.begin, end, &r);
-            if (r != VM::NotARegister && r > mMaxRegister)
-                mMaxRegister = r;
-
-            /* pass 0 (null) as the "type" because it is
-             * not actually used by the interpreter, only in (the current)
-             * codegen (acording to rogerl.)
-             */
-            VM::TypedRegister tr = VM::TypedRegister(r, 0);
-
-            StringAtom *sap = 0;
-            if (argName) {
-                sap = &(mCx->getWorld().identifiers[argName->c_str()]);
-                delete argName;
-            }
-            else { 
-                /* if an argument name was not specified, use the position
-                 * to build a default name.
-                 */
-                s_fmt << (uint32)al->size();
-                sap = &(mCx->getWorld().identifiers[s_fmt.getString()]);
-                s_fmt.clear();
-
-            }
-            VM::Argument arg = VM::Argument (tr, sap);
-            
-            al->push_back(arg);
-
-            tl = seekTokenStart (begin, end);
-            /* if the next token is a comma,
-             * seek to the next one and go again */
-            if (tl.estimate == teComma) {
-                tl = seekTokenStart (tl.begin + 1, end);
-            }
-        }
-
-        if (tl.estimate != teCloseParen)
-            throw JSParseException (eidExpectCloseParen);
-
-        *rval = al;
-
-        return tl.begin + 1;
-    }
-
-    string8_citer
-    ICodeParser::parseExprNodeKindOperand (string8_citer begin, string8_citer end,
-                                       ExprNode::Kind *rval)
-    {
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        if (tl.estimate != teAlpha)
-            throw JSParseException (eidExpectBinaryOp);
-        string8 *str;
-        end = lexAlpha (tl.begin, end, &str);
-
-        for (int i = 0; keyword_exprNodeKinds[i] != 0; ++i)
-            if (cmp_nocase (*str, keyword_exprNodeKinds[i], keyword_exprNodeKinds[i] +
-                            strlen (keyword_exprNodeKinds[i])) == 0) {
-                *rval = exprNodeOps[i];
-                delete str;
-                return end;
-            }
-        
-        delete str;
-        throw JSParseException (eidUnknownBinaryOp);
-    }
-
-    string8_citer
-    ICodeParser::parseBoolOperand (string8_citer begin, string8_citer end,
-                                   bool *rval)
-    {
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        if (tl.estimate != teAlpha)
-            throw JSParseException (eidExpectBool);
-
-        return lexBool (tl.begin, end, rval);
-    }
-
-    string8_citer
-    ICodeParser::parseDoubleOperand (string8_citer begin, string8_citer end,
-                                     double *rval)
-    {
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        if ((tl.estimate != teNumeric) && (tl.estimate != teMinus) &&
-            (tl.estimate != tePlus))
-            throw JSParseException (eidExpectDouble);
-
-        return lexDouble (tl.begin, end, rval);
-    }
-
-    string8_citer
-    ICodeParser::parseICodeModuleOperand (string8_citer begin,
-                                          string8_citer end, 
-                                          VM::ICodeModule **rval)
-    {
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        if (tl.estimate != teString)
-            throw JSParseException (eidExpectString);
-
-        string8 *str;
-        end = lexString8 (tl.begin, end, &str);
-        StringAtom &typename_atom = mCx->getWorld().identifiers[str->c_str()];
-        delete str;
-        JSTypes::JSValue jsv = 
-            mCx->getGlobalObject()->getVariable(typename_atom);
-        if (!jsv.isFunction()) {
-            ASSERT(false);
-        }
-        *rval = jsv.function->getICode();
-
-        return end;
-//        NOT_REACHED ("ICode modules are hard, lets go shopping.");
-//        return end;
-    }
-    
-    string8_citer
-    ICodeParser::parseJSClassOperand (string8_citer begin,
-                                      string8_citer end, JSTypes::JSType **rval)
-    {
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        if (tl.estimate != teString)
-            throw JSParseException (eidExpectString);
-
-        string8 *str;
-        end = lexString8 (tl.begin, end, &str);
-        StringAtom &typename_atom = mCx->getWorld().identifiers[str->c_str()];
-        delete str;
-        JSTypes::JSValue jsv = 
-            mCx->getGlobalObject()->getVariable(typename_atom);
-        if (jsv.isType())
-            *rval = jsv.type;
-        else
-            *rval = &(JSTypes::Object_Type);
-
-        return end;
-//        NOT_REACHED ("JSClasses are hard, lets go shopping.");
-//        return end;
-    }
-
-    string8_citer
-    ICodeParser::parseJSStringOperand (string8_citer begin, string8_citer end,
-                                       JSTypes::JSString **rval)
-    {
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        if (tl.estimate != teString)
-            throw JSParseException (eidExpectString);
-        string8 *str;
-        end = lexString8 (tl.begin, end, &str);
-        *rval = new JSTypes::JSString (str->c_str());
-        delete str;
-        return end;
-    }
-    
-    string8_citer
-    ICodeParser::parseJSFunctionOperand (string8_citer /*begin*/,
-                                         string8_citer end,
-                                         string ** /*rval*/)
-    {
-        NOT_REACHED ("JSFunctions are hard, lets go shopping.");
-        return end;
-    }
-
-    string8_citer
-    ICodeParser::parseJSTypeOperand (string8_citer begin, string8_citer end,
-                                     JSTypes::JSType **rval)
-    {
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        if (tl.estimate != teString)
-            throw JSParseException (eidExpectString);
-
-        string8 *str;
-        end = lexString8 (tl.begin, end, &str);
-        StringAtom &typename_atom = mCx->getWorld().identifiers[str->c_str()];
-        delete str;
-        JSTypes::JSValue jsv = 
-            mCx->getGlobalObject()->getVariable(typename_atom);
-        if (jsv.isType())
-            *rval = jsv.type;
-        else
-            *rval = &(JSTypes::Object_Type);
-
-        return end;
-    }
-
-    string8_citer
-    ICodeParser::parseLabelOperand (string8_citer begin, string8_citer end,
-                                    VM::Label **rval)
-    {
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        if (tl.estimate != teAlpha)
-            throw JSParseException (eidExpectLabel);
-
-        string8 *str;
-        begin = lexAlpha (tl.begin, end, &str);
-        
-        if (cmp_nocase(*str, keyword_offset, keyword_offset +
-                       strlen(keyword_offset)) == 0) {
-            delete str;
-            /* got the "Offset" keyword, treat next thing as a jump offset
-             * expressed as "Offset +/-N" */
-            tl = seekTokenStart (begin, end);
-
-            if (tl.estimate != teNumeric)
-                throw JSParseException (eidExpectUInt32);
-            
-            uint32 ofs;
-            begin = lexUInt32 (tl.begin, end, &ofs);
-            VM::Label *new_label = new VM::Label(mInstructions);
-            new_label->mOffset = ofs;
-            mLabels.push_back (new_label);
-            *rval = new_label;
-        } else {
-            /* label expressed as "label_name", look for it in the
-             * namedlabels map */
-            LabelMap::const_iterator l = mNamedLabels.find(str->c_str());
-            if (l != mNamedLabels.end()) {
-                /* found the label, use it */
-                *rval = (*l).second;
-            } else {
-                /* havn't seen the label definition yet, put a placeholder
-                 * in the namedlabels map */
-                VM::Label *new_label = new VM::Label(mInstructions);
-                new_label->mOffset = VM::NotALabel;
-                *rval = new_label;
-                mNamedLabels[str->c_str()] = new_label;
-                mLabels.push_back (new_label);
-            }       
-            delete str;
-        }
-        return begin;
-    }
-
-    string8_citer
-    ICodeParser::parseUInt32Operand (string8_citer begin,
-                                     string8_citer end, uint32 *rval)
-    {
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        if (tl.estimate != teNumeric)
-            throw JSParseException (eidExpectUInt32);
-
-        return lexUInt32 (tl.begin, end, rval);
-    }
-
-    string8_citer
-    ICodeParser::parseRegisterOperand (string8_citer begin, string8_citer end,
-                                       JSTypes::Register *rval)
-    {
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        end = lexRegister (tl.begin, end, rval);
-        if (*rval != VM::NotARegister && *rval > mMaxRegister)
-            mMaxRegister = *rval;
-
-        return end;    
-    }
-
-    string8_citer
-    ICodeParser::parseStringAtomOperand (string8_citer begin, string8_citer end,
-                                         StringAtom **rval)
-    {
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        if (tl.estimate != teString)
-            throw JSParseException (eidExpectString);
-        string8 *str;
-        end = lexString8 (tl.begin, end, &str);
-        *rval = &(mCx->getWorld().identifiers[str->c_str()]);
-        delete str;
-        return end;
-    }
-
-    /* "High Level" parse functions ... */
-    string8_citer
-    ICodeParser::parseInstruction (uint icodeID, string8_citer begin,
-                                   string8_citer end)
-    {
-        string8_citer curpos = begin;
-        StatementNode node;
-        node.icodeID = icodeID;
-
-#       define CASE_TYPE(T, C, CTYPE)                                      \
-           case ot##T:                                                     \
-           {                                                               \
-              C rval;                                                      \
-              node.operand[i].type = ot##T;                                \
-              curpos = parse##T##Operand (curpos, end, &rval);             \
-              node.operand[i].data = CTYPE<int64>(rval);                   \
-              break;                                                       \
-           }
- 
-        for (uint i = 0; i < 4; ++i)
-        {
-            switch (icodemap[icodeID].otype[i])
-            {
-                CASE_TYPE(ArgumentList, VM::ArgumentList *, reinterpret_cast);
-                CASE_TYPE(ExprNodeKind, ExprNode::Kind, static_cast);
-                CASE_TYPE(Bool, bool, static_cast);
-                CASE_TYPE(Double, double, static_cast);
-                CASE_TYPE(ICodeModule, VM::ICodeModule *, reinterpret_cast);
-                CASE_TYPE(JSClass, JSTypes::JSType *, reinterpret_cast);
-                CASE_TYPE(JSString, JSTypes::JSString *, reinterpret_cast);
-                CASE_TYPE(JSFunction, string *, reinterpret_cast);
-                CASE_TYPE(JSType, JSTypes::JSType *, reinterpret_cast);
-                CASE_TYPE(Label, VM::Label *, reinterpret_cast);
-                CASE_TYPE(UInt32, uint32, static_cast);
-                CASE_TYPE(Register, JSTypes::Register, static_cast);
-                CASE_TYPE(StringAtom, StringAtom *, reinterpret_cast);
-                default:
-                    node.operand[i].type = otNone;
-                    break;                    
-            }
-            if (i != 3 && icodemap[icodeID].otype[i + 1] != otNone) {
-                /* if the instruction has more arguments, eat a comma and
-                 * locate the next token */
-                TokenLocation tl = seekTokenStart (curpos, end);
-                if (tl.estimate != teComma)
-                    throw JSParseException (eidExpectComma);
-                tl = seekTokenStart (tl.begin + 1, end);
-                curpos = tl.begin;
-            }   
-        }
-
-#       undef CASE_TYPE
-
-        mInstructions->push_back (InstructionFromNode(&node));
-        ++mInstructionCount;
-        
-        TokenLocation tl = seekTokenStart (curpos, end);
-        if (tl.estimate != teNewline && tl.estimate != teEOF)
-            throw JSParseException (eidExpectNewline);
-        
-        if (tl.estimate == teEOF)
-            return tl.begin;
-        else
-            return tl.begin + 1;
-    }
-
-    string8_citer
-    ICodeParser::parseNextStatement (string8_citer begin, string8_citer end)
-    {
-        bool isLabel = false;
-        string8_citer firstTokenEnd = end;
-        TokenLocation tl = seekTokenStart (begin, end);
-
-        if (tl.estimate == teNewline) {
-            /* empty statement, do nothing */
-            return tl.begin + 1;
-        }
-
-        if (tl.estimate != teAlpha)
-            throw JSParseException (eidExpectIdentifier);
-
-        for (string8_citer curpos = tl.begin; curpos < end; ++curpos) {
-            switch (*curpos)
-            {
-                case ':':
-                    isLabel = true;
-                    firstTokenEnd = ++curpos;
-                    goto scan_done;
-
-                default:
-                    if (!IS_ALPHA(*curpos)) {
-                        firstTokenEnd = curpos;
-                        goto scan_done;
-                    }
-            }
-        }
-    scan_done:
-        
-        if (isLabel) {
-            /* the thing we scanned was a label...
-             * ignore the trailing : */
-            string8 label_str(tl.begin, firstTokenEnd - 1);
-            /* check to see if it was already referenced... */
-            LabelMap::const_iterator l = mNamedLabels.find(label_str.c_str());
-            if (l == mNamedLabels.end()) {
-                /* if it wasn't already referenced, add it */
-                VM::Label *new_label = new VM::Label (mInstructions);
-                new_label->mOffset = mInstructionCount;
-                mNamedLabels[label_str.c_str()] = new_label;
-                mLabels.push_back(new_label);
-            } else {
-                /* if it was already referenced, check to see if the offset
-                 * was already set */
-                if ((*l).second->mOffset == VM::NotALabel) {
-                    /* offset not set yet, set it and move along */
-                    (*l).second->mOffset = mInstructionCount;
-                } else {
-                    /* offset was already set, this must be a dupe! */
-                    throw JSParseException (eidDuplicateLabel);
-                }
-            }
-        } else {
-            /* the thing we scanned was an instruction, search the icode map
-             * for a matching instruction */
-            string8 icode_str(tl.begin, firstTokenEnd);
-            for (uint i = 0; i < icodemap_size; ++i)
-                if (cmp_nocase(icode_str, &icodemap[i].name[0],
-                               &icodemap[i].name[0] +
-                               strlen(icodemap[i].name)) == 0)
-                    /* if match found, parse it's operands */
-                    return parseInstruction (i, firstTokenEnd, end);
-            /* otherwise, choke on it */
-            throw JSParseException (eidUnknownICode);
-        }
-        return firstTokenEnd;
-    }
-    
-}
-}

mozilla/js2/src/icodeasm.h

@@ -1,160 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-
-#ifdef _WIN32
-// Microsoft Visual C++ 6.0 whines about name lengths over 255 getting truncated in the browser database
-#pragma warning(disable : 4786) 
-#endif
-
-
-#ifndef icodeasm_h___
-#define icodeasm_h___
-
-#include <string>
-#include <iterator>
-
-#include "vmtypes.h"
-#include "jstypes.h"
-#include "interpreter.h"
-
-namespace JavaScript {
-namespace ICodeASM {
-
-    enum OperandType {
-        otNone = 0,
-        otArgumentList,
-        otExprNodeKind,
-        otBool,
-        otDouble,
-        otICodeModule,
-        otJSClass,
-        otJSString,
-        otJSFunction,
-        otJSType,
-        otLabel,
-        otUInt32,
-        otRegister,
-        otStringAtom
-    };
-
-    struct AnyOperand {
-        OperandType type;
-        int64 data;
-        /*void *data;*/
-    };
-    
-    struct StatementNode {
-        uint icodeID;
-        AnyOperand operand[4];
-    };
-    
-    class ICodeParser 
-    {
-    private:
-        ICodeParser(const ICodeParser&); /* No copy constructor */
-        
-        Interpreter::Context *mCx;
-        uint32 mInstructionCount;
-        VM::LabelList mLabels; /* contains both named *and* unnamed labels */
-        typedef std::map<const char *, VM::Label*> LabelMap;
-        LabelMap mNamedLabels;
-        
-    public:
-        uint32 mMaxRegister;
-        VM::InstructionStream *mInstructions;
-        
-    public:
-        ICodeParser (Interpreter::Context *aCx) : mCx(aCx), mInstructions(0) {}
-        void parseSourceFromString (const string8 &source);
-
-        /* operand parse functions;  These functions take care of finding
-         * the start of the token with |SeekTokenStart|, and checking the
-         * "estimation" (explicit checking takes care of |begin| == |end|,
-         * aka EOF, because EOF is a token estimate.)  Once the start of the
-         * token is found, and it is of the expected type, the actual parsing is
-         * carried out by one of the general purpose parse functions.
-         */
-        string8_citer
-        parseArgumentListOperand (string8_citer begin, string8_citer end,
-                                  VM::ArgumentList **rval);
-        string8_citer
-        parseExprNodeKindOperand (string8_citer begin, string8_citer end,
-                                    JavaScript::ExprNode::Kind *rval);
-        string8_citer
-        parseBoolOperand (string8_citer begin, string8_citer end,
-                          bool *rval);
-        string8_citer
-        parseDoubleOperand (string8_citer begin, string8_citer end,
-                            double *rval);
-        string8_citer
-        parseICodeModuleOperand (string8_citer begin, string8_citer end,
-                                 VM::ICodeModule **rval);
-        string8_citer
-        parseJSClassOperand (string8_citer begin, string8_citer end,
-                             JSTypes::JSType **rval);
-        string8_citer
-        parseJSStringOperand (string8_citer begin, string8_citer end,
-                              JSTypes::JSString **rval);
-        string8_citer
-        parseJSFunctionOperand (string8_citer begin, string8_citer end,
-                                string8 **rval);
-        string8_citer
-        parseJSTypeOperand (string8_citer begin, string8_citer end,
-                            JSTypes::JSType **rval);
-        string8_citer
-        parseLabelOperand (string8_citer begin, string8_citer end,
-                           VM::Label **rval);
-        string8_citer
-        parseUInt32Operand (string8_citer begin, string8_citer end,
-                            uint32 *rval);
-        string8_citer
-        parseRegisterOperand (string8_citer begin, string8_citer end,
-                              JSTypes::Register *rval);
-        string8_citer
-        parseStringAtomOperand (string8_citer begin, string8_citer end,
-                                StringAtom **rval);
-
-        /* "high level" parse functions */
-        string8_citer
-        parseInstruction (uint icodeID, string8_citer start,
-                          string8_citer end);
-        string8_citer
-        parseNextStatement (string8_citer begin, string8_citer end);
-
-    };
-    
-}
-}
-
-#endif /* #ifndef icodeasm_h___ */

mozilla/js2/src/icodegenerator.cpp

@@ -1,905 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
-*
-* The contents of this file are subject to the Netscape Public
-* License Version 1.1 (the "License"); you may not use this file
-* except in compliance with the License. You may obtain a copy of
-* the License at http://www.mozilla.org/NPL/
-*
-* Software distributed under the License is distributed on an "AS
-* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
-* implied. See the License for the specific language governing
-* rights and limitations under the License.
-*
-* The Original Code is the JavaScript 2 Prototype.
-*
-* The Initial Developer of the Original Code is Netscape
-* Communications Corporation.  Portions created by Netscape are
-* Copyright (C) 1998 Netscape Communications Corporation. All
-* Rights Reserved.
-*
-* Contributor(s): 
-*
-* Alternatively, the contents of this file may be used under the
-* terms of the GNU Public License (the "GPL"), in which case the
-* provisions of the GPL are applicable instead of those above.
-* If you wish to allow use of your version of this file only
-* under the terms of the GPL and not to allow others to use your
-* version of this file under the NPL, indicate your decision by
-* deleting the provisions above and replace them with the notice
-* and other provisions required by the GPL.  If you do not delete
-* the provisions above, a recipient may use your version of this
-* file under either the NPL or the GPL.
-*/
-
-#ifdef _WIN32
- // Turn off warnings about identifiers too long in browser information
- #pragma warning(disable: 4786)
-#endif
-
-#include <algorithm>
-#include "numerics.h"
-#include "world.h"
-#include "vmtypes.h"
-#include "jstypes.h"
-#include "jsclasses.h"
-#include "icodegenerator.h"
-#include "interpreter.h"
-#include "exception.h"
-#include "icodeasm.h"
-
-#include <stdexcept>
-#include <stdio.h>
-
-namespace JavaScript {
-namespace ICG {
-
-using namespace VM;
-using namespace JSTypes;
-using namespace JSClasses;
-using namespace Interpreter;
-using namespace ICodeASM;
-
-inline char narrow(char16 ch) { return char(ch); }
-
-
-uint32 ICodeModule::sMaxID = 0;
-    
-Formatter& operator<<(Formatter &f, ICodeGenerator &i)
-{
-    return i.print(f);
-}
-
-Formatter& operator<<(Formatter &f, ICodeModule &i)
-{
-    return i.print(f);
-}
-
-//
-// ICodeGenerator
-//
-
-
-ICodeGenerator::ICodeGenerator(Context *cx, 
-                               ICodeGenerator *containingFunction, 
-                               JSClass *aClass, 
-                               ICodeGeneratorFlags flags,
-                               JSType *resultType)
-    :   mTopRegister(0), 
-        mExceptionRegister(TypedRegister(NotARegister, &None_Type)),
-        variableList(new VariableList()),
-        parameterList(new ParameterList()),
-        mContext(cx),
-        mInstructionMap(new InstructionMap()),
-        mClass(aClass),
-        mFlags(flags),
-        pLabels(NULL),
-        mInitName(cx->getWorld().identifiers["__init__"]),
-        mContainingFunction(containingFunction),
-        mResultType(resultType)
-{ 
-    iCode = new InstructionStream();
-    iCodeOwner = true;
-}
-
-/*
-    -Called to allocate parameter and variable registers, aka 'permanent' registers.
-    -mTopRegister is the current high-water mark.
-    -mPermanentRegister marks those registers given to variables/parameters.
-    -Theoretically, mPermanentRegister[n] can be become false when a scope ends and
-     the registers allocated to contained variables are then available for re-use.
-    -Mostly the need is to handle overlapping allocation of temps & permanents as the
-     variables' declarations are encountered. This wouldn't be necessary if a function
-     presented a list of all variables, or a pre-pass executed to discover same.
-*/
-TypedRegister ICodeGenerator::allocateRegister(JSType *type) 
-{
-    Register r = mTopRegister;
-    while (r < mPermanentRegister.size())
-        if (!mPermanentRegister[r]) 
-            break;
-        else
-            ++r;
-    if (r == mPermanentRegister.size())
-        mPermanentRegister.resize(r + 1);
-    mPermanentRegister[r] = true;
-
-    TypedRegister result(r, type); 
-    mTopRegister = ++r;
-    return result;
-}
-
-TypedRegister ICodeGenerator::allocateVariable(const StringAtom& name, const StringAtom& typeName)
-{
-    return allocateVariable(name, mContext->findType(typeName));
-}
-
-TypedRegister ICodeGenerator::allocateParameter(const StringAtom& name, bool isOptional, const StringAtom& typeName)
-{
-    return allocateParameter(name, isOptional, mContext->findType(typeName));
-}
-
-ICodeModule *ICodeGenerator::complete()
-{
-#ifdef DEBUG
-    for (LabelList::iterator i = labels.begin();
-         i != labels.end(); i++) {
-        ASSERT((*i)->mBase == iCode);
-        ASSERT((*i)->mOffset <= iCode->size());
-    }
-#endif
-
-
-    if (iCode->size()) {
-        ICodeOp lastOp = (*iCode)[iCode->size() - 1]->op();
-        if ((lastOp != RETURN) && (lastOp != RETURN_VOID))
-            returnStmt();
-    }
-    else
-        returnStmt();
-     
-
-    /*
-    XXX FIXME
-    I wanted to do the following rather than have to have the label set hanging around as well
-    as the ICodeModule. Branches have since changed, but the concept is still good and should
-    be re-introduced at some point.
-
-    for (InstructionIterator ii = iCode->begin(); 
-         ii != iCode->end(); ii++) {            
-        if ((*ii)->op() == BRANCH) {
-            Instruction *t = *ii;
-            *ii = new ResolvedBranch(static_cast<Branch *>(*ii)->operand1->itsOffset);
-            delete t;
-        }
-        else 
-            if ((*ii)->itsOp >= BRANCH_LT && (*ii)->itsOp <= BRANCH_GT) {
-                Instruction *t = *ii;
-                *ii = new ResolvedBranchCond((*ii)->itsOp, 
-                                             static_cast<BranchCond *>(*ii)->itsOperand1->itsOffset,
-                                             static_cast<BranchCond *>(*ii)->itsOperand2);
-                delete t;
-            }
-    }
-    */
-    ICodeModule* module = new ICodeModule(*this);
-    if (pLabels) {
-        uint32 i;
-        uint32 parameterInits = pLabels->size() - 1;        // there's an extra label at the end for the actual entryPoint
-        module->mParameterInit = new uint32[parameterInits];
-        for (i = 0; i < parameterInits; i++) {
-            module->mParameterInit[i] = (*pLabels)[i]->mOffset;
-        }
-        module->mEntryPoint = (*pLabels)[i]->mOffset;
-    }
-    iCodeOwner = false;   // give ownership to the module.
-    return module;
-}
-
-
-/********************************************************************/
-
-TypedRegister ICodeGenerator::loadImmediate(double value)
-{
-    TypedRegister dest(getTempRegister(), &Number_Type);
-    LoadImmediate *instr = new LoadImmediate(dest, value);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::loadString(const String &value)
-{
-    TypedRegister dest(getTempRegister(), &String_Type);
-    LoadString *instr = new LoadString(dest, new JSString(value));
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::loadString(const StringAtom &value)
-{
-    TypedRegister dest(getTempRegister(), &String_Type);
-    LoadString *instr = new LoadString(dest, new JSString(value));
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::loadBoolean(bool value)
-{
-    TypedRegister dest(getTempRegister(), &Boolean_Type);
-    if (value) 
-        iCode->push_back(new LoadTrue(dest));
-    else
-        iCode->push_back(new LoadFalse(dest));
-    return dest;
-}
-
-TypedRegister ICodeGenerator::loadNull()
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    iCode->push_back(new LoadNull(dest));
-    return dest;
-}
-
-TypedRegister ICodeGenerator::loadType(JSType *type)
-{
-    TypedRegister dest(getTempRegister(), type);
-    iCode->push_back(new LoadType(dest, type));
-    return dest;
-}
-
-
-TypedRegister ICodeGenerator::newObject(TypedRegister constructor)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    NewObject *instr = new NewObject(dest, constructor);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::newClass(JSClass *clazz)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    NewClass *instr = new NewClass(dest, clazz);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::genericNew(TypedRegister target, ArgumentList *args)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    NewGeneric *instr = new NewGeneric(dest, target, args);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::newFunction(ICodeModule *icm)
-{
-    TypedRegister dest(getTempRegister(), &Function_Type);
-    NewFunction *instr = new NewFunction(dest, icm);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::newArray()
-{
-    TypedRegister dest(getTempRegister(), &Array_Type);
-    NewArray *instr = new NewArray(dest);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::dotClass(TypedRegister base)
-{
-    TypedRegister dest(getTempRegister(), &Type_Type);
-    Class *instr = new Class(dest, base);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::instanceOf(TypedRegister base, TypedRegister type)
-{
-    TypedRegister dest(getTempRegister(), &Boolean_Type);
-    Instanceof *instr = new Instanceof(dest, base, type);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::is(TypedRegister base, TypedRegister type)
-{
-    TypedRegister dest(getTempRegister(), &Boolean_Type);
-    Is *instr = new Is(dest, base, type);
-    iCode->push_back(instr);
-    return dest;
-}
-
-
-TypedRegister ICodeGenerator::loadName(const StringAtom &name, JSType *t)
-{
-    TypedRegister dest(getTempRegister(), t);
-    LoadName *instr = new LoadName(dest, &name);
-    iCode->push_back(instr);
-    return dest;
-}
-
-void ICodeGenerator::saveName(const StringAtom &name, TypedRegister value)
-{
-    SaveName *instr = new SaveName(&name, value);
-    iCode->push_back(instr);
-}
-
-TypedRegister ICodeGenerator::nameXcr(const StringAtom &name, ICodeOp op)
-{
-    TypedRegister dest(getTempRegister(), &Number_Type);
-    NameXcr *instr = new NameXcr(dest, &name, (op == ADD) ? 1.0 : -1.0);
-    iCode->push_back(instr);
-    return dest;
-}
-
-
-
-TypedRegister ICodeGenerator::varXcr(TypedRegister var, ICodeOp op)
-{
-    TypedRegister dest(getTempRegister(), &Number_Type);
-    VarXcr *instr = new VarXcr(dest, var, (op == ADD) ? 1.0 : -1.0);
-    iCode->push_back(instr);
-    return dest;
-}
-
-
-TypedRegister ICodeGenerator::getField(TypedRegister base, TypedRegister field)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    GetField *instr = new GetField(dest, base, field);
-    iCode->push_back(instr);
-    return dest;
-}
-
-void ICodeGenerator::setField(TypedRegister base, TypedRegister field,
-                                 TypedRegister value)
-{
-    SetField *instr = new SetField(base, field, value);
-    iCode->push_back(instr);
-}
-
-
-TypedRegister ICodeGenerator::deleteProperty(TypedRegister base, const StringAtom &name)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    DeleteProp *instr = new DeleteProp(dest, base, &name);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::getProperty(TypedRegister base, const StringAtom &name)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    GetProp *instr = new GetProp(dest, base, &name);
-    iCode->push_back(instr);
-    return dest;
-}
-
-void ICodeGenerator::setProperty(TypedRegister base, const StringAtom &name,
-                                 TypedRegister value)
-{
-    SetProp *instr = new SetProp(base, &name, value);
-    iCode->push_back(instr);
-}
-
-TypedRegister ICodeGenerator::propertyXcr(TypedRegister base, const StringAtom &name, ICodeOp op)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    PropXcr *instr = new PropXcr(dest, base, &name, (op == ADD) ? 1.0 : -1.0);
-    iCode->push_back(instr);
-    return dest;
-}
-
-
-static const JSSlot& getStaticSlot(JSClass *&c, const String &name)
-{
-    if (c->hasStatic(name))
-        return c->getStatic(name);
-    c = c->getSuperClass();
-    ASSERT(c);
-    return getStaticSlot(c, name);
-}
-
-TypedRegister ICodeGenerator::getStatic(JSClass *base, const String &name)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    const JSSlot& slot = getStaticSlot(base, name);
-    GetStatic *instr = new GetStatic(dest, base, slot.mIndex);
-    iCode->push_back(instr);
-    return dest;
-}
-
-void ICodeGenerator::setStatic(JSClass *base, const StringAtom &name,
-                                 TypedRegister value)
-{
-    const JSSlot& slot = getStaticSlot(base, name);
-    SetStatic *instr = new SetStatic(base, slot.mIndex, value);
-    iCode->push_back(instr);
-}
-
-TypedRegister ICodeGenerator::staticXcr(JSClass *base, const StringAtom &name, ICodeOp /*op*/)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    const JSSlot& slot = getStaticSlot(base, name);
-    StaticXcr *instr = new StaticXcr(dest, base, slot.mIndex, 1.0);
-    iCode->push_back(instr);
-    return dest;
-}
-
-
-
-TypedRegister ICodeGenerator::getSlot(TypedRegister base, uint32 slot)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    GetSlot *instr = new GetSlot(dest, base, slot);
-    iCode->push_back(instr);
-    return dest;
-}
-
-void ICodeGenerator::setSlot(TypedRegister base, uint32 slot,
-                                 TypedRegister value)
-{
-    SetSlot *instr = new SetSlot(base, slot, value);
-    iCode->push_back(instr);
-}
-
-TypedRegister ICodeGenerator::slotXcr(TypedRegister base, uint32 slot, ICodeOp op)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    SlotXcr *instr = new SlotXcr(dest, base, slot, (op == ADD) ? 1.0 : -1.0);
-    iCode->push_back(instr);
-    return dest;
-}
-
-
-
-
-TypedRegister ICodeGenerator::getElement(TypedRegister base, TypedRegister index)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    GetElement *instr = new GetElement(dest, base, index);
-    iCode->push_back(instr);
-    return dest;
-}
-
-void ICodeGenerator::setElement(TypedRegister base, TypedRegister index,
-                                TypedRegister value)
-{
-    SetElement *instr = new SetElement(base, index, value);
-    iCode->push_back(instr);
-}
-
-TypedRegister ICodeGenerator::elementXcr(TypedRegister base, TypedRegister index, ICodeOp op)
-{
-    TypedRegister dest(getTempRegister(), &Number_Type);
-    ElemXcr *instr = new ElemXcr(dest, base, index, (op == ADD) ? 1.0 : -1.0);
-    iCode->push_back(instr);
-    return dest;
-}
-
-
-
-TypedRegister ICodeGenerator::op(ICodeOp op, TypedRegister source)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    ASSERT(source.first != NotARegister);    
-    Unary *instr = new Unary (op, dest, source);
-    iCode->push_back(instr);
-    return dest;
-}
-    
-    
-void ICodeGenerator::move(TypedRegister destination, TypedRegister source)
-{
-    ASSERT(destination.first != NotARegister);    
-    ASSERT(source.first != NotARegister);    
-    Move *instr = new Move(destination, source);
-    iCode->push_back(instr);
-}
-
-TypedRegister ICodeGenerator::logicalNot(TypedRegister source)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    Not *instr = new Not(dest, source);
-    iCode->push_back(instr);
-    return dest;
-} 
-
-TypedRegister ICodeGenerator::test(TypedRegister source)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    Test *instr = new Test(dest, source);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::op(ICodeOp op, TypedRegister source1, 
-                            TypedRegister source2)
-{
-    ASSERT(source1.first != NotARegister);    
-    ASSERT(source2.first != NotARegister);    
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    Arithmetic *instr = new Arithmetic(op, dest, source1, source2);
-    iCode->push_back(instr);
-    return dest;
-} 
-
-TypedRegister ICodeGenerator::binaryOp(ICodeOp dblOp, JSTypes::Operator op, TypedRegister source1, 
-                            TypedRegister source2)
-{
-    ASSERT(source1.first != NotARegister);    
-    ASSERT(source2.first != NotARegister);
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    
-    if ((source1.second == &Number_Type) && (source2.second == &Number_Type)) {
-        Arithmetic *instr = new Arithmetic(dblOp, dest, source1, source2);
-        iCode->push_back(instr);
-    }
-    else {
-        GenericBinaryOP *instr = new GenericBinaryOP(dest, op, source1, source2);
-        iCode->push_back(instr);
-    }
-    return dest;
-}
-
-TypedRegister ICodeGenerator::unaryOp(JSTypes::Operator op, TypedRegister source)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    GenericUnaryOP *instr = new GenericUnaryOP(dest, op, source);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::xcrementOp(JSTypes::Operator op, TypedRegister source)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    GenericXcrementOP *instr = new GenericXcrementOP(dest, op, source);
-    iCode->push_back(instr);
-    return dest;
-}
-    
-TypedRegister ICodeGenerator::call(TypedRegister target, ArgumentList *args)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    DirectCall *instr = new DirectCall(dest, target, args);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::invokeCallOp(TypedRegister target, ArgumentList *args)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    InvokeCall *instr = new InvokeCall(dest, target, args);
-    iCode->push_back(instr);
-    return dest;
-}
-/*
-TypedRegister ICodeGenerator::directCall(JSFunction *target, ArgumentList *args)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    DirectCall *instr = new DirectCall(dest, target, args);
-    iCode->push_back(instr);
-    return dest;
-}
-*/
-TypedRegister ICodeGenerator::bindThis(TypedRegister thisArg, TypedRegister target)
-{
-    TypedRegister dest(getTempRegister(), &Function_Type);
-    iCode->push_back(new BindThis(dest, thisArg, target));
-    return dest;
-}
-
-
-TypedRegister ICodeGenerator::getClosure(uint32 count)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    iCode->push_back(new GetClosure(dest, count));
-    return dest;
-}
-
-TypedRegister ICodeGenerator::newClosure(ICodeModule *icm)
-{
-    TypedRegister dest(getTempRegister(), &Function_Type);
-    iCode->push_back(new NewClosure(dest, icm));
-    return dest;
-}
-
-
-TypedRegister ICodeGenerator::getMethod(TypedRegister thisArg, uint32 slotIndex)
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    GetMethod *instr = new GetMethod(dest, thisArg, slotIndex);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::super()
-{
-    TypedRegister dest(getTempRegister(), &Object_Type);
-    Super *instr = new Super(dest);
-    iCode->push_back(instr);
-    return dest;
-}
-
-TypedRegister ICodeGenerator::cast(TypedRegister arg, JSType *toType)
-{
-    TypedRegister dest(getTempRegister(), toType);
-    Cast *instr = new Cast(dest, arg, loadType(toType));
-    iCode->push_back(instr);
-    return dest;
-}
-
-void ICodeGenerator::branch(Label *label)
-{
-    Branch *instr = new Branch(label);
-    iCode->push_back(instr);
-}
-
-GenericBranch *ICodeGenerator::branchTrue(Label *label, TypedRegister condition)
-{
-    GenericBranch *instr = new GenericBranch(BRANCH_TRUE, label, condition);
-    iCode->push_back(instr);
-    return instr;
-}
-
-GenericBranch *ICodeGenerator::branchFalse(Label *label, TypedRegister condition)
-{
-    GenericBranch *instr = new GenericBranch(BRANCH_FALSE, label, condition);
-    iCode->push_back(instr);
-    return instr;
-}
-
-GenericBranch *ICodeGenerator::branchInitialized(Label *label, TypedRegister condition)
-{
-    GenericBranch *instr = new GenericBranch(BRANCH_INITIALIZED, label, condition);
-    iCode->push_back(instr);
-    return instr;
-}
-
-
-
-
-void ICodeGenerator::returnStmt(TypedRegister r)
-{
-    iCode->push_back(new Return(r));
-}
-
-void ICodeGenerator::returnStmt()
-{
-    iCode->push_back(new ReturnVoid());
-}
-
-
-/********************************************************************/
-
-Label *ICodeGenerator::getLabel()
-{
-    labels.push_back(new Label(NULL));
-    return labels.back();
-}
-
-Label *ICodeGenerator::setLabel(Label *l)
-{
-    l->mBase = iCode;
-    l->mOffset = iCode->size();
-    return l;
-}
-
-
-Formatter& ICodeGenerator::print(Formatter& f)
-{
-    f << "ICG! " << (uint32)iCode->size() << "\n";
-    VM::operator<<(f, *iCode);
-    f << "  Src  :  Instr" << "\n";
-    for (InstructionMap::iterator i = mInstructionMap->begin(); i != mInstructionMap->end(); i++)
-    {
-        printDec( f, (*i).first, 6);
-        f << " : ";
-        printDec( f, (*i).second, 6);
-        f << "\n";
-//        f << (*i)->first << " : " << (*i)->second << "\n";
-    }
-    return f;
-}
-
-Formatter& ICodeModule::print(Formatter& f)
-{
-    f << "ICM[" << mID << "] from source at '" << mFileName << "' " <<
-        (uint32)its_iCode->size() << " bytecodes\n";
-    return VM::operator<<(f, *its_iCode);
-}
-
-/*************************************************************************/
-
-Formatter& operator<<(Formatter &f, string &s)
-{
-    f << s.c_str();
-    return f;
-}
-
-ICodeModule *ICodeGenerator::readFunction(XMLNode *element, JSClass *thisClass)
-{
-#ifdef TEST_ICASM
-    ICodeModule *result = NULL;
-
-    String resultTypeName;
-    element->getValue(widenCString("type"), resultTypeName);
-    ParameterList *theParameterList = new ParameterList();
-    theParameterList->add(mContext->getWorld().identifiers["this"], TypedRegister(0, thisClass), false);
-    uint32 pCount = 1;
-    StringFormatter s;
-    XMLNodeList &parameters = element->children();
-    for (XMLNodeList::const_iterator k = parameters.begin(); k != parameters.end(); k++) {
-        XMLNode *parameter = *k;
-        if (parameter->name().compare(widenCString("parameter")) == 0) {                    
-            String parameterName;
-            String parameterTypeName;
-            element->getValue(widenCString("name"), parameterName);
-            element->getValue(widenCString("type"), parameterTypeName);
-            JSType *parameterType = mContext->findType(mContext->getWorld().identifiers[parameterTypeName]);
-            theParameterList->add(mContext->getWorld().identifiers[parameterName], TypedRegister(pCount, parameterType), false);
-            s << pCount - 1;
-            theParameterList->add(mContext->getWorld().identifiers[s.getString()], TypedRegister(pCount, parameterType), false);
-            s.clear();
-            pCount++;
-        }
-    }
-    theParameterList->setPositionalCount(pCount);
-
-    JSType *resultType = mContext->findType(mContext->getWorld().identifiers[resultTypeName]);
-    String &body = element->body();
-    if (body.length()) {
-        std::string str(body.length(), char());
-        std::transform(body.begin(), body.end(), str.begin(), narrow);
-        ICodeParser icp(mContext);
-
-        stdOut << "Calling ICodeParser with :\n" << str << "\n";
-
-        icp.parseSourceFromString(str);
-
-        result = new ICodeModule(icp.mInstructions, 
-                                            NULL,                   /* VariableList *variables */
-                                            theParameterList,       /* ParameterList *parameters */
-                                            icp.mMaxRegister, 
-                                            NULL,                   /* InstructionMap *instructionMap */
-                                            resultType, 
-                                            NotABanana);            /* exception register */
-    }
-    return result;
-#else
-    return 0;
-#endif
-}
-
-ICodeModule *ICodeGenerator::readICode(const char *fileName)
-{
-#ifdef TEST_ICASM
-    ICodeModule *result = NULL;
-
-    XMLParser xp(fileName);
-    XMLNode *top = xp.parseDocument();
-    stdOut << *top;
-
-    XMLNodeList &kids = top->children();
-    for (XMLNodeList::const_iterator i = kids.begin(); i != kids.end(); i++) {
-        XMLNode *node = *i;
-
-        if (node->name().compare(widenCString("class")) == 0) {
-            String className;
-            String superName;
-            JSClass* superclass = 0;
-
-            node->getValue(widenCString("name"), className);
-            if (node->getValue(widenCString("super"), superName)) {
-                const JSValue& superclassValue = mContext->getGlobalObject()->getVariable(superName);
-                superclass = static_cast<JSClass*>(superclassValue.object);
-            }
-            JSClass* thisClass = new JSClass(mContext->getGlobalObject(), className, superclass);
-            JSScope* thisScope = thisClass->getScope();
-            Context *classContext = new Context(mContext->getWorld(), thisScope);
-            ICodeGenerator scg(classContext, NULL, thisClass, kIsStaticMethod, &Void_Type);
-            ICodeGenerator ccg(classContext, NULL, thisClass, kNoFlags, &Void_Type);
-            ccg.allocateParameter(mContext->getWorld().identifiers["this"], false, thisClass);
-            thisClass->defineStatic(mInitName, &Function_Type);
-
-            mContext->getGlobalObject()->defineVariable(className, &Type_Type, JSValue(thisClass));
-
-            XMLNodeList &elements = node->children();
-            for (XMLNodeList::const_iterator j = elements.begin(); j != elements.end(); j++) {
-                XMLNode *element = *j;
-                bool isConstructor = (element->name().compare(widenCString("constructor")) == 0);
-
-                if (isConstructor || (element->name().compare(widenCString("method")) == 0)) {
-                    String methodName;
-                    node->getValue(widenCString("name"), methodName);
-                    ICodeModule *icm = readFunction(element, thisClass);
-                    if (icm) {
-                        if (isConstructor) {
-                            thisClass->defineConstructor(methodName);
-                            scg.setStatic(thisClass, mContext->getWorld().identifiers[methodName], scg.newFunction(icm));
-                        }
-                        else
-                            thisClass->defineMethod(methodName, new JSFunction(icm));
-                    }
-                }
-                else {
-                    if (element->name().compare(widenCString("field")) == 0) {
-                        String fieldName;
-                        String fieldType;
-
-                        element->getValue(widenCString("name"), fieldName);
-                        element->getValue(widenCString("type"), fieldType);
-                        JSType *type = mContext->findType(mContext->getWorld().identifiers[fieldType]);
-
-                        if (element->hasAttribute(widenCString("static")))
-                            thisClass->defineStatic(fieldName, type);
-                        else
-                            thisClass->defineSlot(fieldName, type);
-                    }
-                }
-            }
-            scg.setStatic(thisClass, mInitName, scg.newFunction(ccg.complete())); 
-            thisClass->complete();
-        
-            if (scg.getICode()->size()) {
-                ICodeModule* clinit = scg.complete();
-                classContext->interpret(clinit, JSValues());
-                delete clinit;
-            }
-            delete classContext;
-        }
-        else {
-            if (node->name().compare(widenCString("script")) == 0) {
-                String &body = node->body();
-                if (body.length()) {
-                    std::string str(body.length(), char());
-                    std::transform(body.begin(), body.end(), str.begin(), narrow);
-                    ICodeParser icp(mContext);
-
-                    stdOut << "(script) Calling ICodeParser with :\n" << str << "\n";
-
-                    icp.parseSourceFromString(str);
-
-                    result = new ICodeModule(icp.mInstructions, 
-                                                        NULL,                   /* VariableList *variables */
-                                                        NULL,                   /* ParameterList *parameters */
-                                                        icp.mMaxRegister, 
-                                                        NULL,                   /* InstructionMap *instructionMap */
-                                                        &Void_Type, 
-                                                        NotABanana);            /* exception register */
-                }                        
-            }
-            else {
-                if (node->name().compare(widenCString("function")) == 0) {
-                    String functionName;
-                    node->getValue(widenCString("name"), functionName);
-                    ICodeModule *icm = readFunction(node, NULL);
-                    mContext->getGlobalObject()->defineFunction(functionName, icm);
-                }
-                else {
-                    if (node->name().compare(widenCString("instance")) == 0) {
-                        // find the appropriate class and initialize the fields
-                    }
-                    else {
-                        if (node->name().compare(widenCString("object")) == 0) {
-                            // an object literal
-                        }
-                    }
-                }
-            }
-        }
-
-    }
-    return result;
-#else
-    return 0;
-#endif
-}
-    
-
-    
-} // namespace ICG
-
-} // namespace JavaScript

mozilla/js2/src/icodegenerator.h

@@ -1,469 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef icodegenerator_h
-#define icodegenerator_h
-
-#include <vector>
-#include <stack>
-
-#include "utilities.h"
-#include "parser.h"
-#include "vmtypes.h"
-#include "jsclasses.h"
-#include "xmlparser.h"
-
-
-namespace JavaScript {
-namespace ICG {
-    
-    using namespace VM;
-    using namespace JSTypes;
-    using namespace JSClasses;
-    
-    // forward declarations of classes in this header
-    class ICodeGenerator;
-    class ICodeModule;
-
-
-    struct VariableList {       // Maps from variable (parameter) name to a TypedRegister.
-                                // But because we also want to map from a register number to
-                                // it's type, we keep the TypedRegsters in a separate array and
-                                // just store the index in the name map.
-
-        typedef std::map<String, uint32, std::less<String> > VariableMap;
-        typedef VariableMap::value_type MapValue;
-
-        VariableMap variableMap;
-        std::vector<TypedRegister> registerList;
-    
-        TypedRegister findVariable(const StringAtom& name)
-        {
-            VariableMap::iterator i = variableMap.find(name);
-            return (i == variableMap.end()) 
-                        ? TypedRegister(NotARegister, &None_Type) 
-                        : registerList[i->second];
-        }
-
-        void add(const StringAtom& name, TypedRegister r)
-        {
-            variableMap.insert(MapValue(name, r.first));
-            registerList.resize(r.first + 1);
-            registerList[r.first] = r;
-        }
-
-        TypedRegister getRegister(uint32 i)
-        {
-            ASSERT(i < registerList.size());
-            return registerList[i];
-        }
-
-
-    };
-
-    struct ParameterList : public VariableList {
-        typedef enum { 
-            NoRestParameter, 
-            HasRestParameterBeforeBar, 
-            HasRestParameterAfterBar, 
-            HasUnnamedRestParameter 
-        } RestParameterStatus;
-
-        
-        
-        std::vector<bool> mOptionalParameters;      // whether or not a parameter has an optional value
-                                                    // ordered by lexical ordering === register number.
-        RestParameterStatus mRestParameter;
-        uint32 mPositionalCount;                    // number of positional parameters
-
-
-
-
-        ParameterList() : mRestParameter(NoRestParameter), mPositionalCount(0) { }
-
-        void add(const StringAtom& name, TypedRegister r, bool isOptional)
-        {
-            VariableList::add(name, r);
-            mOptionalParameters.resize(r.first + 1);
-            mOptionalParameters[r.first] = isOptional;
-        }
-
-        uint32 size()   { return registerList.size(); }     // the variableMap may be larger since it contains aliases
-
-        bool isOptional(uint32 i)   { ASSERT(i < mOptionalParameters.size()); return mOptionalParameters[i]; }
-
-        void setRestParameter(RestParameterStatus rs)   { mRestParameter = rs; }
-        void setPositionalCount(uint32 x)               { mPositionalCount = x; }
-
-    };
-
-
-    typedef enum { NoKind, Var, Property, Slot, Static, Constructor, Name, Method, ClosureVar, Field } LValueKind;
-
-    class Reference {
-    public:
-        Reference(const StringAtom &name) : mKind(NoKind), mName(name) { }
-
-        LValueKind mKind;
-
-        TypedRegister mBase;
-        const StringAtom &mName;
-        TypedRegister mField;
-        
-        uint32 mSlotIndex;
-        JSClass *mClass;
-
-        JSType *mType;
-
-        TypedRegister getValue(ICodeGenerator *icg);
-        void setValue(ICodeGenerator *icg, TypedRegister value);
-        TypedRegister getCallTarget(ICodeGenerator *icg);
-    };
-
-    typedef std::vector<const StringAtom *> LabelSet;
-    class LabelEntry {
-    public:
-        LabelEntry(LabelSet *labelSet, Label *breakLabel) 
-            : labelSet(labelSet), breakLabel(breakLabel), continueLabel(NULL) { }
-        LabelEntry(LabelSet *labelSet, Label *breakLabel, Label *continueLabel) 
-            : labelSet(labelSet), breakLabel(breakLabel), continueLabel(continueLabel) { }
-
-        bool containsLabel(const StringAtom *label);
-
-        LabelSet *labelSet;
-        Label *breakLabel;
-        Label *continueLabel;
-    };
-    typedef std::vector<LabelEntry *> LabelStack;
-
-
-    typedef std::map<uint32, uint32, std::less<uint32> > InstructionMap;
-     
-    /****************************************************************/
-    
-    // An ICodeGenerator provides the interface between the parser and the
-    // interpreter. The parser constructs one of these for each
-    // function/script, adds statements and expressions to it and then
-    // converts it into an ICodeModule, ready for execution.
-    
-    class ICodeGenerator {
-    public:
-        friend class ICodeModule;
-        typedef enum { kNoFlags = 0, kIsTopLevel = 0x01, kIsStaticMethod = 0x02, kIsWithinWith = 0x04 } ICodeGeneratorFlags;
-    private:
-        InstructionStream *iCode;
-        bool iCodeOwner;
-        LabelList labels;
-        
-        Register mTopRegister;              // highest (currently) allocated register
-        TypedRegister mExceptionRegister;   // reserved to carry the exception object.
-        VariableList *variableList;         // name|register pair for each variable
-        ParameterList *parameterList;       // name|register pair for each parameter
-                                            // (with #0 reserved for 'this' regardless of scope)
-        
-        Context *mContext;                  // the world and global object
-        LabelStack mLabelStack;             // stack of LabelEntry objects, one per nested looping construct
-                                            // maps source position to instruction index
-        InstructionMap *mInstructionMap;
-
-        JSClass *mClass;                    // enclosing class when generating code for methods
-        ICodeGeneratorFlags mFlags;         // assorted flags
-        LabelList *pLabels;                 // label for each parameter initialization entry point
-
-        const StringAtom &mInitName;
-        ICodeGenerator *mContainingFunction;// outer function for nested functions
-        JSType *mResultType;
-
-        std::vector<bool> mPermanentRegister;
-
-        Register getTempRegister() 
-        { 
-            while (mTopRegister < mPermanentRegister.size())
-                if (!mPermanentRegister[mTopRegister]) 
-                    return mTopRegister++;
-                else
-                    ++mTopRegister;
-            mPermanentRegister.resize(mTopRegister + 1);
-            mPermanentRegister[mTopRegister] = false;
-            return mTopRegister++;
-        }
-
-        void resetTopRegister() { mTopRegister = 0; }
-        void resetStatement()   { resetTopRegister(); }
-
-        TypedRegister allocateRegister(JSType *type);
-
-
-
-        void addParameterLabel(Label *label)    { if (pLabels == NULL) pLabels = new LabelList(); pLabels->push_back(label); }
-
-
-        Label *setLabel(Label *label);
-        
-        void jsr(Label *label)                  { iCode->push_back(new Jsr(label)); }
-        void rts()                              { iCode->push_back(new Rts()); }
-        void branch(Label *label);
-        GenericBranch *branchTrue(Label *label, TypedRegister condition);
-        GenericBranch *branchFalse(Label *label, TypedRegister condition);
-        GenericBranch *branchInitialized(Label *label, TypedRegister condition);
-        
-        void beginTry(Label *catchLabel, Label *finallyLabel)
-                                                { iCode->push_back(new Tryin(catchLabel, finallyLabel)); }
-        void endTry()                           { iCode->push_back(new Tryout()); }
-
-        void beginWith(TypedRegister obj)       { iCode->push_back(new Within(obj)); }
-        void endWith()                          { iCode->push_back(new Without()); }
-        
-
-        void startStatement(uint32 pos)         { (*mInstructionMap)[iCode->size()] = pos; }
-
-        bool isTopLevel()       { return (mFlags & kIsTopLevel) != 0; }
-        bool isWithinWith()     { return (mFlags & kIsWithinWith) != 0; }
-        bool isStaticMethod()   { return (mFlags & kIsStaticMethod) != 0; }
-
-        void setFlag(uint32 flag, bool v) { mFlags = (ICodeGeneratorFlags)((v) ? mFlags | flag : mFlags & ~flag); }
-
-        bool getVariableByName(const StringAtom &name, Reference &ref);
-        bool scanForVariable(const StringAtom &name, Reference &ref);
-        bool resolveIdentifier(const StringAtom &name, Reference &ref, bool lvalue);
-        ICodeModule *genFunction(FunctionDefinition &function, bool isStatic, bool isConstructor, JSClass *superClass);
-
-        Reference genReference(ExprNode *p);
-        Operator getOperator(uint32 parameterCount, String &name);
-        
-        ICodeModule *readFunction(XMLNode *element, JSClass *thisClass);
-
-    public:
-
-        ICodeGenerator(Context *cx, 
-                            ICodeGenerator *containingFunction = NULL, 
-                            JSClass *aClass = NULL, 
-                            ICodeGeneratorFlags flags = kIsTopLevel,
-                            JSType *resultType = &Object_Type);
-        
-        ~ICodeGenerator()
-        {
-            if (iCodeOwner) {
-                delete iCode;
-                delete mInstructionMap;
-                if (pLabels) delete pLabels;
-            }
-        }
-                
-        ICodeModule *complete();
-        ICodeModule *readICode(const char *fileName);
-    
-        TypedRegister genExpr(ExprNode *p, 
-                                bool needBoolValueInBranch = false, 
-                                Label *trueBranch = NULL, 
-                                Label *falseBranch = NULL);
-        TypedRegister genStmt(StmtNode *p, LabelSet *currentLabelSet = NULL);
-
-        void returnStmt(TypedRegister r);
-        void returnStmt();
-        void throwStmt(TypedRegister r)         { iCode->push_back(new Throw(r)); }
-        void debuggerStmt()                     { iCode->push_back(new Debugger()); }
-
-        TypedRegister allocateVariable(const StringAtom& name)
-        { 
-            return allocateVariable(name, &Object_Type);
-        }
-        
-        TypedRegister allocateVariable(const StringAtom& name, const StringAtom& typeName);
-        
-        TypedRegister allocateVariable(const StringAtom& name, JSType *type)
-        { 
-            TypedRegister r = allocateRegister(type);
-            variableList->add(name, r);
-            return r;
-        }
-        
-        TypedRegister allocateVariable(const StringAtom& name, TypedRegister r)
-        { 
-            variableList->add(name, r);
-            return r;
-        }
-        
-        TypedRegister allocateParameter(const StringAtom& name, bool isOptional)
-        { 
-            return allocateParameter(name, isOptional, &Object_Type);
-        }
-        
-        TypedRegister allocateParameter(const StringAtom& name, bool isOptional, const StringAtom& typeName);
-        
-        TypedRegister allocateParameter(const StringAtom& name, bool isOptional, JSType *type)
-        { 
-            TypedRegister r = allocateRegister(type);
-            parameterList->add(name, r, isOptional);
-            return r;
-        }
-
-        
-        Formatter& print(Formatter& f);
-        
-        TypedRegister op(ICodeOp op, TypedRegister source);
-        TypedRegister op(ICodeOp op, TypedRegister source1, TypedRegister source2);
-        TypedRegister binaryOp(ICodeOp dblOp, JSTypes::Operator op, TypedRegister source1, TypedRegister source2);
-        TypedRegister unaryOp(JSTypes::Operator op, TypedRegister source);
-        TypedRegister invokeCallOp(TypedRegister target, ArgumentList *args);
-        TypedRegister xcrementOp(JSTypes::Operator op, TypedRegister source);
-        TypedRegister call(TypedRegister target, ArgumentList *args);
-//        TypedRegister directCall(JSFunction *target, ArgumentList *args);
-        TypedRegister bindThis(TypedRegister thisArg, TypedRegister target);
-        TypedRegister getMethod(TypedRegister thisArg, uint32 slotIndex);
-        TypedRegister getClosure(uint32 count);
-        TypedRegister newClosure(ICodeModule *icm);
-
-        void move(TypedRegister destination, TypedRegister source);
-        TypedRegister logicalNot(TypedRegister source);
-        TypedRegister test(TypedRegister source);
-        
-        TypedRegister loadBoolean(bool value);
-        TypedRegister loadImmediate(double value);
-        TypedRegister loadString(const String &value);
-        TypedRegister loadString(const StringAtom &name);
-        TypedRegister loadNull();
-        TypedRegister loadType(JSType *toType);
-                
-        TypedRegister newObject(TypedRegister constructor);
-        TypedRegister newArray();
-        TypedRegister newFunction(ICodeModule *icm);
-        TypedRegister newClass(JSClass *clazz);
-        TypedRegister genericNew(TypedRegister target, ArgumentList *args);
-
-        TypedRegister cast(TypedRegister arg, JSType *toType);
-        TypedRegister dotClass(TypedRegister base);
-        TypedRegister instanceOf(TypedRegister base, TypedRegister type);
-        TypedRegister is(TypedRegister base, TypedRegister type);
-
-        
-        TypedRegister super();
-        TypedRegister loadName(const StringAtom &name, JSType *t = &Object_Type);
-        void saveName(const StringAtom &name, TypedRegister value);
-        TypedRegister nameXcr(const StringAtom &name, ICodeOp op);
-
-        TypedRegister getField(TypedRegister base, TypedRegister field);
-        void setField(TypedRegister base, TypedRegister field, TypedRegister value);        
-
-        TypedRegister deleteProperty(TypedRegister base, const StringAtom &name);
-        TypedRegister getProperty(TypedRegister base, const StringAtom &name);
-        void setProperty(TypedRegister base, const StringAtom &name, TypedRegister value);
-        TypedRegister propertyXcr(TypedRegister base, const StringAtom &name, ICodeOp op);
-        
-        TypedRegister getStatic(JSClass *base, const String &name);
-        void setStatic(JSClass *base, const StringAtom &name, TypedRegister value);
-        TypedRegister staticXcr(JSClass *base, const StringAtom &name, ICodeOp op);
-        
-        TypedRegister getElement(TypedRegister base, TypedRegister index);
-        void setElement(TypedRegister base, TypedRegister index, TypedRegister value);
-        TypedRegister elementXcr(TypedRegister base, TypedRegister index, ICodeOp op);
-
-        TypedRegister getSlot(TypedRegister base, uint32 slot);
-        void setSlot(TypedRegister base, uint32 slot, TypedRegister value);
-        TypedRegister slotXcr(TypedRegister base, uint32 slot, ICodeOp op);
-
-        TypedRegister varXcr(TypedRegister var, ICodeOp op);
-        
-        InstructionStream *getICode()   { return iCode; }
-        
-        Label *getLabel();
-
-    };
-
-    class ICodeModule {
-    public:
-        ICodeModule(InstructionStream *iCode, VariableList *variables,
-                    ParameterList *parameters,
-                    uint32 maxRegister,
-                    InstructionMap *instructionMap, 
-                    JSType *resultType, uint32 exceptionRegister) :
-            its_iCode(iCode), itsVariables(variables), itsParameters(parameters),
-            itsMaxRegister(maxRegister),
-            mID(++sMaxID), mInstructionMap(instructionMap), 
-            mParameterInit(NULL), 
-            mEntryPoint(0),
-            mResultType(resultType),
-            mExceptionRegister(exceptionRegister)
-        {
-        }
-
-        ICodeModule(ICodeGenerator &icg) :
-            its_iCode(icg.iCode), itsVariables(icg.variableList), itsParameters(icg.parameterList),
-            itsMaxRegister(icg.mPermanentRegister.size()),
-            mID(++sMaxID), mInstructionMap(icg.mInstructionMap), 
-            mParameterInit(NULL), 
-            mEntryPoint(0),
-            mResultType(icg.mResultType),
-            mExceptionRegister(icg.mExceptionRegister.first)
-        {
-        }
-
-
-        ~ICodeModule()
-        {
-            delete its_iCode;
-            delete itsVariables;
-            delete mInstructionMap;
-            if (mParameterInit) delete mParameterInit;
-        }
-
-        Formatter& print(Formatter& f);
-        void setFileName (String aFileName) { mFileName = aFileName; }
-        String getFileName () { return mFileName; }
-        
-        InstructionStream *its_iCode;
-        VariableList *itsVariables;
-        ParameterList *itsParameters;
-        uint32 itsMaxRegister;
-        uint32 mID;
-        InstructionMap *mInstructionMap;
-        String mFileName;
-        uint32 *mParameterInit;
-        uint32 mEntryPoint;
-        JSType *mResultType;
-        uint32 mExceptionRegister;
-
-        static uint32 sMaxID;
-        
-    };
-
-    Formatter& operator<<(Formatter &f, ICodeGenerator &i);
-    Formatter& operator<<(Formatter &f, ICodeModule &i);
-    Formatter& operator<<(Formatter &f, std::string &s);
-
-
-
-} /* namespace IGC */
-} /* namespace JavaScript */
-
-#endif /* icodegenerator_h */

mozilla/js2/src/icodemap.h

@@ -1,417 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-/***** THIS FILE IS AUTO GENERATED!  DO NOT EDIT THIS FILE! *****
- * make changes to js2/tools/genmap.pl and regenerate this file *
- ***** THIS FILE IS AUTO GENERATED!  DO NOT EDIT THIS FILE! *****/
-
-#ifndef __icodemap_h
-
-#define __icodemap_h
-
-#include "systemtypes.h"
-#include "icodeasm.h"
-
-namespace JavaScript {
-namespace ICodeASM {
-
-    static uint icodemap_size = 85;
-
-    static struct {
-        char *name;
-        OperandType otype[4];
-    } icodemap [] = {
-        {"ADD", {otRegister, otRegister, otRegister}},
-        {"AND", {otRegister, otRegister, otRegister}},
-        {"BIND_THIS", {otRegister, otRegister, otRegister}},
-        {"BITNOT", {otRegister, otRegister}},
-        {"BRANCH", {otLabel}},
-        {"BRANCH_FALSE", {otLabel, otRegister}},
-        {"BRANCH_INITIALIZED", {otLabel, otRegister}},
-        {"BRANCH_TRUE", {otLabel, otRegister}},
-        {"CAST", {otRegister, otRegister, otRegister}},
-        {"CLASS", {otRegister, otRegister}},
-        {"COMPARE_EQ", {otRegister, otRegister, otRegister}},
-        {"COMPARE_GE", {otRegister, otRegister, otRegister}},
-        {"COMPARE_GT", {otRegister, otRegister, otRegister}},
-        {"COMPARE_IN", {otRegister, otRegister, otRegister}},
-        {"COMPARE_LE", {otRegister, otRegister, otRegister}},
-        {"COMPARE_LT", {otRegister, otRegister, otRegister}},
-        {"COMPARE_NE", {otRegister, otRegister, otRegister}},
-        {"DEBUGGER", {otNone}},
-        {"DELETE_PROP", {otRegister, otRegister, otStringAtom}},
-        {"DIRECT_CALL", {otRegister, otRegister, otArgumentList}},
-        {"DIVIDE", {otRegister, otRegister, otRegister}},
-        {"ELEM_XCR", {otRegister, otRegister, otRegister, otDouble}},
-        {"GENERIC_BINARY_OP", {otRegister, otJSTypesOperator, otRegister, otRegister}},
-        {"GENERIC_UNARY_OP", {otRegister, otJSTypesOperator, otRegister}},
-        {"GENERIC_XCREMENT_OP", {otRegister, otJSTypesOperator, otRegister}},
-        {"GET_CLOSURE", {otRegister, otUInt32}},
-        {"GET_ELEMENT", {otRegister, otRegister, otRegister}},
-        {"GET_FIELD", {otRegister, otRegister, otRegister}},
-        {"GET_METHOD", {otRegister, otRegister, otUInt32}},
-        {"GET_PROP", {otRegister, otRegister, otStringAtom}},
-        {"GET_SLOT", {otRegister, otRegister, otUInt32}},
-        {"GET_STATIC", {otRegister, otJSClass, otUInt32}},
-        {"INSTANCEOF", {otRegister, otRegister, otRegister}},
-        {"INVOKE_CALL", {otRegister, otRegister, otArgumentList}},
-        {"IS", {otRegister, otRegister, otRegister}},
-        {"JSR", {otLabel}},
-        {"LOAD_FALSE", {otRegister}},
-        {"LOAD_IMMEDIATE", {otRegister, otDouble}},
-        {"LOAD_NAME", {otRegister, otStringAtom}},
-        {"LOAD_NULL", {otRegister}},
-        {"LOAD_STRING", {otRegister, otJSString}},
-        {"LOAD_TRUE", {otRegister}},
-        {"LOAD_TYPE", {otRegister, otJSType}},
-        {"MOVE", {otRegister, otRegister}},
-        {"MULTIPLY", {otRegister, otRegister, otRegister}},
-        {"NAME_XCR", {otRegister, otStringAtom, otDouble}},
-        {"NEGATE_DOUBLE", {otRegister, otRegister}},
-        {"NEW_ARRAY", {otRegister}},
-        {"NEW_CLASS", {otRegister, otJSClass}},
-        {"NEW_CLOSURE", {otRegister, otICodeModule}},
-        {"NEW_FUNCTION", {otRegister, otICodeModule}},
-        {"NEW_GENERIC", {otRegister, otRegister, otArgumentList}},
-        {"NEW_OBJECT", {otRegister, otRegister}},
-        {"NOP", {otNone}},
-        {"NOT", {otRegister, otRegister}},
-        {"OR", {otRegister, otRegister, otRegister}},
-        {"POSATE_DOUBLE", {otRegister, otRegister}},
-        {"PROP_XCR", {otRegister, otRegister, otStringAtom, otDouble}},
-        {"REMAINDER", {otRegister, otRegister, otRegister}},
-        {"RETURN", {otRegister}},
-        {"RETURN_VOID", {otNone}},
-        {"RTS", {otNone}},
-        {"SAVE_NAME", {otStringAtom, otRegister}},
-        {"SET_ELEMENT", {otRegister, otRegister, otRegister}},
-        {"SET_FIELD", {otRegister, otRegister, otRegister}},
-        {"SET_PROP", {otRegister, otStringAtom, otRegister}},
-        {"SET_SLOT", {otRegister, otUInt32, otRegister}},
-        {"SET_STATIC", {otJSClass, otUInt32, otRegister}},
-        {"SHIFTLEFT", {otRegister, otRegister, otRegister}},
-        {"SHIFTRIGHT", {otRegister, otRegister, otRegister}},
-        {"SLOT_XCR", {otRegister, otRegister, otUInt32, otDouble}},
-        {"STATIC_XCR", {otRegister, otJSClass, otUInt32, otDouble}},
-        {"STRICT_EQ", {otRegister, otRegister, otRegister}},
-        {"STRICT_NE", {otRegister, otRegister, otRegister}},
-        {"SUBTRACT", {otRegister, otRegister, otRegister}},
-        {"SUPER", {otRegister}},
-        {"TEST", {otRegister, otRegister}},
-        {"THROW", {otRegister}},
-        {"TRYIN", {otLabel, otLabel}},
-        {"TRYOUT", {otNone}},
-        {"USHIFTRIGHT", {otRegister, otRegister, otRegister}},
-        {"VAR_XCR", {otRegister, otRegister, otDouble}},
-        {"WITHIN", {otRegister}},
-        {"WITHOUT", {otNone}},
-        {"XOR", {otRegister, otRegister, otRegister}},
-    };
-
-    VM::Instruction *InstructionFromNode (StatementNode *node)
-    {
-        using namespace VM;
-        using namespace JSTypes;
-        Instruction *i;
-        
-        switch (node->icodeID)
-        {
-            case 0:
-                i = new Add (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 1:
-                i = new And (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 2:
-                i = new BindThis (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 3:
-                i = new Bitnot (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 4:
-                i = new Branch (reinterpret_cast<Label*>(node->operand[0].data));
-                break;
-            case 5:
-                i = new BranchFalse (reinterpret_cast<Label*>(node->operand[0].data), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 6:
-                i = new BranchInitialized (reinterpret_cast<Label*>(node->operand[0].data), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 7:
-                i = new BranchTrue (reinterpret_cast<Label*>(node->operand[0].data), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 8:
-                i = new Cast (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 9:
-                i = new Class (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 10:
-                i = new CompareEQ (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 11:
-                i = new CompareGE (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 12:
-                i = new CompareGT (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 13:
-                i = new CompareIN (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 14:
-                i = new CompareLE (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 15:
-                i = new CompareLT (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 16:
-                i = new CompareNE (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 17:
-                i = new Debugger ();
-                break;
-            case 18:
-                i = new DeleteProp (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<const StringAtom*>(node->operand[2].data));
-                break;
-            case 19:
-                i = new DirectCall (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<ArgumentList*>(node->operand[2].data));
-                break;
-            case 20:
-                i = new Divide (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 21:
-                i = new ElemXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0), static_cast<double>(node->operand[3].data));
-                break;
-            case 22:
-                i = new GenericBinaryOP (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<JSTypes::Operator>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0), TypedRegister(static_cast<Register>(node->operand[3].data), 0));
-                break;
-            case 23:
-                i = new GenericUnaryOP (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<JSTypes::Operator>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 24:
-                i = new GenericXcrementOP (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<JSTypes::Operator>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 25:
-                i = new GetClosure (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<uint32>(node->operand[1].data));
-                break;
-            case 26:
-                i = new GetElement (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 27:
-                i = new GetField (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 28:
-                i = new GetMethod (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), static_cast<uint32>(node->operand[2].data));
-                break;
-            case 29:
-                i = new GetProp (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<const StringAtom*>(node->operand[2].data));
-                break;
-            case 30:
-                i = new GetSlot (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), static_cast<uint32>(node->operand[2].data));
-                break;
-            case 31:
-                i = new GetStatic (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<JSClass*>(node->operand[1].data), static_cast<uint32>(node->operand[2].data));
-                break;
-            case 32:
-                i = new Instanceof (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 33:
-                i = new InvokeCall (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<ArgumentList*>(node->operand[2].data));
-                break;
-            case 34:
-                i = new Is (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 35:
-                i = new Jsr (reinterpret_cast<Label*>(node->operand[0].data));
-                break;
-            case 36:
-                i = new LoadFalse (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
-                break;
-            case 37:
-                i = new LoadImmediate (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<double>(node->operand[1].data));
-                break;
-            case 38:
-                i = new LoadName (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<const StringAtom*>(node->operand[1].data));
-                break;
-            case 39:
-                i = new LoadNull (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
-                break;
-            case 40:
-                i = new LoadString (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<JSString*>(node->operand[1].data));
-                break;
-            case 41:
-                i = new LoadTrue (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
-                break;
-            case 42:
-                i = new LoadType (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<JSType*>(node->operand[1].data));
-                break;
-            case 43:
-                i = new Move (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 44:
-                i = new Multiply (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 45:
-                i = new NameXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<const StringAtom*>(node->operand[1].data), static_cast<double>(node->operand[2].data));
-                break;
-            case 46:
-                i = new NegateDouble (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 47:
-                i = new NewArray (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
-                break;
-            case 48:
-                i = new NewClass (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<JSClass*>(node->operand[1].data));
-                break;
-            case 49:
-                i = new NewClosure (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<ICodeModule*>(node->operand[1].data));
-                break;
-            case 50:
-                i = new NewFunction (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<ICodeModule*>(node->operand[1].data));
-                break;
-            case 51:
-                i = new NewGeneric (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<ArgumentList*>(node->operand[2].data));
-                break;
-            case 52:
-                i = new NewObject (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 53:
-                i = new Nop ();
-                break;
-            case 54:
-                i = new Not (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 55:
-                i = new Or (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 56:
-                i = new PosateDouble (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 57:
-                i = new PropXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<const StringAtom*>(node->operand[2].data), static_cast<double>(node->operand[3].data));
-                break;
-            case 58:
-                i = new Remainder (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 59:
-                i = new Return (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
-                break;
-            case 60:
-                i = new ReturnVoid ();
-                break;
-            case 61:
-                i = new Rts ();
-                break;
-            case 62:
-                i = new SaveName (reinterpret_cast<const StringAtom*>(node->operand[0].data), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 63:
-                i = new SetElement (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 64:
-                i = new SetField (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 65:
-                i = new SetProp (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<const StringAtom*>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 66:
-                i = new SetSlot (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<uint32>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 67:
-                i = new SetStatic (reinterpret_cast<JSClass*>(node->operand[0].data), static_cast<uint32>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 68:
-                i = new Shiftleft (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 69:
-                i = new Shiftright (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 70:
-                i = new SlotXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), static_cast<uint32>(node->operand[2].data), static_cast<double>(node->operand[3].data));
-                break;
-            case 71:
-                i = new StaticXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<JSClass*>(node->operand[1].data), static_cast<uint32>(node->operand[2].data), static_cast<double>(node->operand[3].data));
-                break;
-            case 72:
-                i = new StrictEQ (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 73:
-                i = new StrictNE (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 74:
-                i = new Subtract (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 75:
-                i = new Super (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
-                break;
-            case 76:
-                i = new Test (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
-                break;
-            case 77:
-                i = new Throw (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
-                break;
-            case 78:
-                i = new Tryin (reinterpret_cast<Label*>(node->operand[0].data), reinterpret_cast<Label*>(node->operand[1].data));
-                break;
-            case 79:
-                i = new Tryout ();
-                break;
-            case 80:
-                i = new Ushiftright (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-            case 81:
-                i = new VarXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), static_cast<double>(node->operand[2].data));
-                break;
-            case 82:
-                i = new Within (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
-                break;
-            case 83:
-                i = new Without ();
-                break;
-            case 84:
-                i = new Xor (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
-                break;
-
-            default:
-                NOT_REACHED("Unknown icodeID");
-        }
-
-        return i;
-        
-    }
-                
- 
-}
-}
-
-#endif /* #ifdef __icodemap_h */

mozilla/js2/src/interpreter.h

@@ -1,203 +0,0 @@
-// -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
-//
-// The contents of this file are subject to the Netscape Public
-// License Version 1.1 (the "License"); you may not use this file
-// except in compliance with the License. You may obtain a copy of
-// the License at http://www.mozilla.org/NPL/
-//
-// Software distributed under the License is distributed on an "AS
-// IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
-// implied. See the License for the specific language governing
-// rights and limitations under the License.
-//
-// The Original Code is the JavaScript 2 Prototype.
-//
-// The Initial Developer of the Original Code is Netscape
-// Communications Corporation.  Portions created by Netscape are
-// Copyright (C) 2000 Netscape Communications Corporation. All
-// Rights Reserved.
-
-#ifndef interpreter_h
-#define interpreter_h
-
-#include "utilities.h"
-#include "icodegenerator.h"
-#include "jstypes.h"
-#include "vmtypes.h"
-#include "gc_allocator.h"
-
-namespace JavaScript {
-namespace Interpreter {
-
-    using namespace ICG;
-    using namespace JSTypes;
-
-    struct Activation;
-    
-    struct Linkage;
-
-    class Context : public gc_base {
-        void initContext();
-    public:
-        explicit Context(World& world, JSScope* aGlobal)
-            : mWorld(world), mGlobal(aGlobal), mLinkage(0), mActivation(0), mCurrentClosure(0) { initContext(); }
-
-        Context(Context *cx) : mWorld(cx->getWorld()), mGlobal(cx->getGlobalObject()), 
-                                mLinkage(0), mActivation(0), mCurrentClosure(0) 
-        { 
-            initContext();
-            for (ListenerIterator i = cx->mListeners.begin(), e = cx->mListeners.end(); i != e; ++i)
-                addListener(*i);
-        }
-
-        World& getWorld()           { return mWorld; }
-        JSScope* getGlobalObject()  { return mGlobal; }
-        InstructionIterator getPC() { return mPC; }
-        
-        JSValues& getRegisters();
-        ICodeModule* getICode();
-
-        enum Event {
-            EV_NONE     = 0x0000,
-            EV_STEP     = 0x0001,
-            EV_THROW    = 0x0002,
-            EV_DEBUG    = 0x0004,
-            EV_ALL      = 0xffff
-        };
-    
-        class Listener {
-        public:
-            virtual void listen(Context *context, Event event) = 0;
-        };
-    
-        void addListener(Listener* listener);
-        void removeListener(Listener* listener);
-    
-        class Frame {
-        public:
-            virtual Frame* getNext() = 0;
-            virtual void getState(InstructionIterator& pc, JSValues*& registers,
-                                  ICodeModule*& iCode) = 0;
-        };
-    
-        Frame* getFrames();
-
-        JSValue interpret(ICodeModule* iCode, const JSValues& args);
-        bool invokeFunction(JSFunction *target, JSValues* &registers, TypedRegister resultReg, JSValue thisArg, ArgumentList *args);
-
-
-
-        ICodeModule* compileFunction(const String &source);
-        ICodeModule* genCode(StmtNode *p, const String &fileName);
-        JSValue readEvalFile(FILE* in, const String& fileName);
-
-        ICodeModule* loadClass(const char *fileName);
-
-        const JSValue findBinaryOverride(JSValue &operand1, JSValue &operand2, JSTypes::Operator op);
-        const JSValue findUnaryOverride(JSValue &operand1, JSTypes::Operator op);
-
-        JSType *findType(const StringAtom& typeName);
-        JSType *extractType(ExprNode *t);
-        JSType *getParameterType(FunctionDefinition &function, int index);
-        uint32 getParameterCount(FunctionDefinition &function);
-
-    private:
-        void broadcast(Event event);
-        void initOperatorsPackage();
-        bool hasNamedArguments(ArgumentList &args);
-
-    private:
-        World& mWorld;
-        JSScope* mGlobal;
-        Linkage* mLinkage;
-        typedef std::vector<Listener*, gc_allocator<Listener*> > ListenerList;
-        typedef ListenerList::iterator ListenerIterator;
-        ListenerList mListeners;
-        Activation* mActivation;
-        ICodeModule* mICode;
-        JSClosure* mCurrentClosure;
-
-        InstructionIterator mPC;
-        
-    }; /* class Context */
-
-    /**
-    * 
-    */
-    struct Handler: public gc_base {
-        Handler(Label *catchLabel, Label *finallyLabel)
-            : catchTarget(catchLabel), finallyTarget(finallyLabel) {}
-        Label *catchTarget;
-        Label *finallyTarget;
-    };
-    typedef std::vector<Handler *> CatchStack;
-
-
-    /**
-     * Represents the current function's invocation state.
-     */
-    struct Activation : public JSObject {
-        JSValues mRegisters;
-        CatchStack catchStack;
-        
-        Activation(uint32 highRegister, const JSValues& args)
-            : mRegisters(highRegister + 1)
-        {
-            // copy arg list to initial registers.
-            JSValues::iterator dest = mRegisters.begin();
-            for (JSValues::const_iterator src = args.begin(), 
-                     end = args.end(); src != end; ++src, ++dest) {
-                *dest = *src;
-            }
-        }
-
-        Activation(uint32 highRegister, Activation* caller, const JSValue thisArg,
-                     const ArgumentList* list)
-            : mRegisters(highRegister + 1)
-        {
-            // copy caller's parameter list to initial registers.
-            JSValues::iterator dest = mRegisters.begin();
-            *dest++ = thisArg;
-            if (list) {
-                const JSValues& params = caller->mRegisters;
-                for (ArgumentList::const_iterator src = list->begin(), 
-                         end = list->end(); src != end; ++src, ++dest) {
-                    Register r = (*src).first.first;
-                    if (r != NotARegister)
-                        *dest = params[r];
-                    else
-                        *dest = JSValue(JSValue::uninitialized_tag);
-                }
-            }
-        }
-
-        // calling a binary operator, no 'this'
-        Activation(uint32 highRegister, const JSValue thisArg, const JSValue arg1, const JSValue arg2)
-            : mRegisters(highRegister + 1)
-        {
-            mRegisters[0] = thisArg;
-            mRegisters[1] = arg1;
-            mRegisters[2] = arg2;
-        }
-
-        // calling a getter function, no arguments
-        Activation(uint32 highRegister, const JSValue thisArg)
-            : mRegisters(highRegister + 1)
-        {
-            mRegisters[0] = thisArg;
-        }
-
-        // calling a setter function, 1 argument
-        Activation(uint32 highRegister, const JSValue thisArg, const JSValue arg)
-            : mRegisters(highRegister + 1)
-        {
-            mRegisters[0] = thisArg;
-            mRegisters[1] = arg;
-        }
-
-    };  /* struct Activation */
-
-} /* namespace Interpreter */
-} /* namespace JavaScript */
-
-#endif /* interpreter_h */

mozilla/js2/src/jsarray.cpp

@@ -1,550 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifdef _WIN32
- // Turn off warnings about identifiers too long in browser information
-#pragma warning(disable: 4786)
-#pragma warning(disable: 4711)
-#pragma warning(disable: 4710)
-#endif
-
-#include <algorithm>
-
-#include "parser.h"
-#include "numerics.h"
-#include "js2runtime.h"
-
-// this is the IdentifierList passed to the name lookup routines
-#define CURRENT_ATTR    (NULL)
-
-#include "jsarray.h"
-
-namespace JavaScript {    
-namespace JS2Runtime {
-
-JSValue Array_Constructor(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    JSValue thatValue = thisValue;
-    if (thatValue.isNull())
-        thatValue = Array_Type->newInstance(cx);
-    ASSERT(thatValue.isObject());
-    JSObject *thisObj = thatValue.object;
-    ASSERT(dynamic_cast<JSArrayInstance *>(thisObj));
-    JSArrayInstance *arrInst = (JSArrayInstance *)thisObj;
-    if (argc > 0) {
-        if (argc == 1) {
-            arrInst->mLength = (uint32)(argv[0].toNumber(cx).f64);
-        }
-        else {
-            arrInst->mLength = argc;
-            for (uint32 i = 0; i < argc; i++) {
-                String *id = numberToString(i);
-                arrInst->defineVariable(cx, *id, (NamespaceList *)(NULL), Object_Type, argv[i]);
-                delete id;
-            }
-        }
-    }
-    return thatValue;
-}
-
-
-static JSValue Array_toString(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    ASSERT(thisValue.isObject());
-    JSObject *thisObj = thisValue.object;
-    ASSERT(dynamic_cast<JSArrayInstance *>(thisObj));
-    JSArrayInstance *arrInst = (JSArrayInstance *)thisObj;
-
-    ContextStackReplacement csr(cx);
-
-    if (arrInst->mLength == 0)
-        return JSValue(new String(widenCString("")));
-    else {
-        String *s = new String();
-        for (uint32 i = 0; i < arrInst->mLength; i++) {
-            String *id = numberToString(i);
-            arrInst->getProperty(cx, *id, NULL);
-            JSValue result = cx->popValue();
-            s->append(*result.toString(cx).string);
-            if (i < (arrInst->mLength - 1))
-                s->append(widenCString(","));
-        }
-        return JSValue(s);
-    }
-    
-}
-
-static JSValue Array_toSource(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    ASSERT(thisValue.isObject());
-    JSObject *thisObj = thisValue.object;
-    ASSERT(dynamic_cast<JSArrayInstance *>(thisObj));
-    JSArrayInstance *arrInst = (JSArrayInstance *)thisObj;
-
-    ContextStackReplacement csr(cx);
-
-    if (arrInst->mLength == 0)
-        return JSValue(new String(widenCString("[]")));
-    else {
-        String *s = new String(widenCString("["));
-        for (uint32 i = 0; i < arrInst->mLength; i++) {
-            String *id = numberToString(i);
-            arrInst->getProperty(cx, *id, NULL);
-            JSValue result = cx->popValue();
-            if (!result.isUndefined())
-                s->append(*result.toString(cx).string);
-            if (i < (arrInst->mLength - 1))
-                s->append(widenCString(", "));
-        }
-        s->append(widenCString("]"));
-        return JSValue(s);
-    }
-    
-}
-
-static JSValue Array_push(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ASSERT(thisValue.isObject());
-    JSObject *thisObj = thisValue.object;
-    ASSERT(dynamic_cast<JSArrayInstance *>(thisObj));
-    JSArrayInstance *arrInst = (JSArrayInstance *)thisObj;
-
-    for (uint32 i = 0; i < argc; i++) {
-        String *id = numberToString(i + arrInst->mLength);
-        arrInst->defineVariable(cx, *id, (NamespaceList *)(NULL), Object_Type, argv[i]);
-        delete id;
-    }
-    arrInst->mLength += argc;
-    return JSValue((float64)arrInst->mLength);
-}
-              
-static JSValue Array_pop(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    ASSERT(thisValue.isObject());
-    JSObject *thisObj = thisValue.object;
-    ASSERT(dynamic_cast<JSArrayInstance *>(thisObj));
-    JSArrayInstance *arrInst = (JSArrayInstance *)thisObj;
-
-    ContextStackReplacement csr(cx);
-
-    if (arrInst->mLength > 0) {
-        String *id = numberToString(arrInst->mLength - 1);
-        arrInst->getProperty(cx, *id, NULL);
-        JSValue result = cx->popValue();
-        arrInst->deleteProperty(*id, NULL);
-        --arrInst->mLength;
-        delete id;
-        return result;
-    }
-    else
-        return kUndefinedValue;
-}
-
-JSValue Array_concat(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    JSValue E = thisValue;
-
-    JSArrayInstance *A = (JSArrayInstance *)(Array_Type->newInstance(cx));
-    uint32 n = 0;
-    uint32 i = 0;
-
-    ContextStackReplacement csr(cx);
-
-    do {
-        if (E.getType() != Array_Type) {
-            String *id = numberToString(n++);
-            A->setProperty(cx, *id, CURRENT_ATTR, E);            
-        }
-        else {
-            ASSERT(E.isObject() && dynamic_cast<JSArrayInstance *>(E.object));
-            JSArrayInstance *arrInst = (JSArrayInstance *)(E.object);
-            for (uint32 k = 0; k < arrInst->mLength; k++) {
-                String *id = numberToString(k);
-                arrInst->getProperty(cx, *id, NULL);
-                JSValue result = cx->popValue();
-                id = numberToString(n++);
-                A->setProperty(cx, *id, CURRENT_ATTR, result);            
-            }
-        }
-        E = argv[i++];
-    } while (i <= argc);
-    
-    return JSValue(A);
-}
-
-static JSValue Array_join(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ContextStackReplacement csr(cx);
-
-    ASSERT(thisValue.isObject());
-    JSObject *thisObj = thisValue.object;
-
-    thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
-    JSValue result = cx->popValue();
-    uint32 length = (uint32)(result.toUInt32(cx).f64);    
-
-    const String *separator;
-    if (argc == 0)
-        separator = new String(',', 1);
-    else
-        separator = argv[0].toString(cx).string;
-
-    thisObj->getProperty(cx, *numberToString(0), CURRENT_ATTR);
-    result = cx->popValue();
-
-    String *S = new String();
-
-    for (uint32 k = 0; k < length; k++) {
-        thisObj->getProperty(cx, *numberToString(0), CURRENT_ATTR);
-        result = cx->popValue();
-        if (!result.isUndefined() && !result.isNull())
-            *S += *result.toString(cx).string;
-
-        if (k < (length - 1))
-            *S += *separator;
-    }
-    
-    return JSValue(S);
-}
-
-static JSValue Array_reverse(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    ContextStackReplacement csr(cx);
-
-    ASSERT(thisValue.isObject());
-    JSObject *thisObj = thisValue.object;
-
-    thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
-    JSValue result = cx->popValue();
-    uint32 length = (uint32)(result.toUInt32(cx).f64);    
-
-    uint32 halfway = length / 2;
-
-    for (uint32 k = 0; k < halfway; k++) {    
-        String *id1 = numberToString(k);
-        String *id2 = numberToString(length - k - 1);
-
-        PropertyIterator it;
-        if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
-            if (thisObj->hasOwnProperty(*id2, CURRENT_ATTR, Read, &it)) {
-                thisObj->getProperty(cx, *id1, CURRENT_ATTR);
-                thisObj->getProperty(cx, *id2, CURRENT_ATTR);
-                thisObj->setProperty(cx, *id1, CURRENT_ATTR, cx->popValue());
-                thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
-            }
-            else {
-                thisObj->getProperty(cx, *id1, CURRENT_ATTR);
-                thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
-                thisObj->deleteProperty(*id1, CURRENT_ATTR);
-            }
-        }
-        else {
-            if (thisObj->hasOwnProperty(*id2, CURRENT_ATTR, Read, &it)) {
-                thisObj->getProperty(cx, *id2, CURRENT_ATTR);
-                thisObj->setProperty(cx, *id1, CURRENT_ATTR, cx->popValue());
-                thisObj->deleteProperty(*id2, CURRENT_ATTR);
-            }
-            else {
-                thisObj->deleteProperty(*id1, CURRENT_ATTR);
-                thisObj->deleteProperty(*id2, CURRENT_ATTR);
-            }
-        }
-    }
-
-    return thisValue;
-}
-
-static JSValue Array_shift(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    ContextStackReplacement csr(cx);
-
-    ASSERT(thisValue.isObject());
-    JSObject *thisObj = thisValue.object;
-
-    thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
-    JSValue result = cx->popValue();
-    uint32 length = (uint32)(result.toUInt32(cx).f64);    
-
-    if (length == 0) {
-        thisObj->setProperty(cx, widenCString("length"), CURRENT_ATTR, result);
-        return kUndefinedValue;
-    }
-
-    thisObj->getProperty(cx, *numberToString(0), CURRENT_ATTR);
-    result = cx->popValue();
-
-    for (uint32 k = 1; k < length; k++) {
-        String *id1 = numberToString(k);
-        String *id2 = numberToString(k - 1);
-
-        PropertyIterator it;
-        if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
-            thisObj->getProperty(cx, *id1, CURRENT_ATTR);
-            thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
-        }
-        else
-            thisObj->deleteProperty(*id2, CURRENT_ATTR);        
-    }
-
-    thisObj->deleteProperty(*numberToString(length - 1), CURRENT_ATTR);
-    thisObj->setProperty(cx, widenCString("length"), CURRENT_ATTR, JSValue((float64)(length - 1)) );
-
-    return result;
-}
-
-static JSValue Array_slice(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ContextStackReplacement csr(cx);
-
-    ASSERT(thisValue.isObject());
-    JSObject *thisObj = thisValue.object;
-
-    JSArrayInstance *A = (JSArrayInstance *)Array_Type->newInstance(cx);
-
-    thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
-    JSValue result = cx->popValue();
-    uint32 length = (uint32)(result.toUInt32(cx).f64);    
-
-    uint32 start, end;
-    if (argc < 1) 
-        start = 0;
-    else {
-        int32 arg0 = (int32)(argv[0].toInt32(cx).f64);
-        if (arg0 < 0) {
-            arg0 += length; 
-            if (arg0 < 0)
-                start = 0;
-            else
-                start = toUInt32(arg0);
-        }
-        else {
-            if (toUInt32(arg0) >= length)    // cast ok since > 0
-                start = length;
-            else
-                start = toUInt32(arg0);
-        }
-    }
-
-    if (argc < 2) 
-        end = length;
-    else {
-        int32 arg1 = (int32)(argv[1].toInt32(cx).f64);
-        if (arg1 < 0) {
-            arg1 += length;
-            if (arg1 < 0)
-                end = 0;
-            else
-                end = toUInt32(arg1);
-        }
-        else {
-            if (toUInt32(arg1) >= length)
-                end = length;
-            else
-                end = toUInt32(arg1);
-        }
-    }
-    
-    uint32 n = 0;
-    while (start < end) {
-        String *id1 = numberToString(start);
-        PropertyIterator it;
-        if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
-            String *id2 = numberToString(n);
-            thisObj->getProperty(cx, *id1, CURRENT_ATTR);
-            A->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
-        }
-        n++;
-        start++;
-    }
-    A->setProperty(cx, widenCString("length"), CURRENT_ATTR, JSValue((float64)n) );
-    return JSValue(A);
-}
-
-static JSValue Array_sort(Context * /*cx*/, const JSValue& /*thisValue*/, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    return kUndefinedValue;
-}
-
-static JSValue Array_splice(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    if (argc > 1) {
-        uint32 k;
-        ContextStackReplacement csr(cx);
-
-        ASSERT(thisValue.isObject());
-        JSObject *thisObj = thisValue.object;
-        thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
-        JSValue result = cx->popValue();
-        uint32 length = (uint32)(result.toUInt32(cx).f64);    
-
-        JSArrayInstance *A = (JSArrayInstance *)Array_Type->newInstance(cx);
-
-        int32 arg0 = (int32)(argv[0].toInt32(cx).f64);
-        uint32 start;
-        if (arg0 < 0) {
-            arg0 += length;
-            if (arg0 < 0)
-                start = 0;
-            else
-                start = toUInt32(arg0);
-        }
-        else {
-            if (toUInt32(arg0) >= length)
-                start = length;
-            else
-                start = toUInt32(arg0);
-        }
-
-        uint32 deleteCount;
-        int32 arg1 = (int32)(argv[1].toInt32(cx).f64);
-        if (arg1 < 0)
-            deleteCount = 0;
-        else
-            if (toUInt32(arg1) >= (length - start))
-                deleteCount = length - start;
-            else
-                deleteCount = toUInt32(arg1);
-        
-        for (k = 0; k < deleteCount; k++) {
-            String *id1 = numberToString(start + k);
-            PropertyIterator it;
-            if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
-                String *id2 = numberToString(k);
-                thisObj->getProperty(cx, *id1, CURRENT_ATTR);
-                A->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
-            }
-        }
-        A->setProperty(cx, widenCString("length"), CURRENT_ATTR, JSValue((float64)deleteCount) );
-
-        uint32 newItemCount = argc - 2;
-        if (newItemCount < deleteCount) {
-            for (k = start; k < (length - deleteCount); k++) {
-                String *id1 = numberToString(k + deleteCount);
-                String *id2 = numberToString(k + newItemCount);
-                PropertyIterator it;
-                if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
-                    thisObj->getProperty(cx, *id1, CURRENT_ATTR);
-                    thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
-                }
-                else
-                    thisObj->deleteProperty(*id2, CURRENT_ATTR);
-            }
-            for (k = length; k > (length - deleteCount + newItemCount); k--) {
-                String *id1 = numberToString(k - 1);
-                thisObj->deleteProperty(*id1, CURRENT_ATTR);
-            }
-        }
-        else {
-            if (newItemCount > deleteCount) {
-                for (k = length - deleteCount; k > start; k--) {
-                    String *id1 = numberToString(k + deleteCount - 1);
-                    String *id2 = numberToString(k + newItemCount - 1);
-                    PropertyIterator it;
-                    if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
-                        thisObj->getProperty(cx, *id1, CURRENT_ATTR);
-                        thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
-                    }
-                    else
-                        thisObj->deleteProperty(*id2, CURRENT_ATTR);
-                }
-            }
-        }
-        k = start;
-        for (uint32 i = 2; i < argc; i++) {
-            String *id1 = numberToString(k++);
-            thisObj->setProperty(cx, *id1, CURRENT_ATTR, argv[i]);
-        }
-        thisObj->setProperty(cx, widenCString("length"), CURRENT_ATTR, JSValue((float64)(length - deleteCount + newItemCount)) );
-
-        return JSValue(A);
-    }
-    return kUndefinedValue;
-}
-
-static JSValue Array_unshift(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ContextStackReplacement csr(cx);
-
-    ASSERT(thisValue.isObject());
-    JSObject *thisObj = thisValue.object;
-    thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
-    JSValue result = cx->popValue();
-    uint32 length = (uint32)(result.toUInt32(cx).f64);
-    uint32 k;
-
-    for (k = length; k > 0; k--) {
-        String *id1 = numberToString(k - 1);
-        String *id2 = numberToString(k + argc - 1);
-        PropertyIterator it;
-        if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
-            thisObj->getProperty(cx, *id1, CURRENT_ATTR);
-            thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
-        }
-        else
-            thisObj->deleteProperty(*id2, CURRENT_ATTR);
-    }
-
-    for (k = 0; k < argc; k++) {
-        String *id1 = numberToString(k);
-        thisObj->setProperty(cx, *id1, CURRENT_ATTR, argv[k]);
-    }
-    thisObj->setProperty(cx, widenCString("length"), CURRENT_ATTR, JSValue((float64)(length + argc)) );
-
-    return thisValue;
-}
-
-
-Context::PrototypeFunctions *getArrayProtos()
-{
-    Context::ProtoFunDef arrayProtos[] = 
-    {
-        { "toString",           String_Type, 0, Array_toString },
-        { "toLocaleString",     String_Type, 0, Array_toString },       // XXX 
-        { "toSource",           String_Type, 0, Array_toSource },
-        { "push",               Number_Type, 1, Array_push },
-        { "pop",                Object_Type, 0, Array_pop },
-        { "concat",             Array_Type,  1, Array_concat },
-        { "join",               String_Type, 1, Array_join },
-        { "reverse",            Array_Type,  0, Array_reverse },
-        { "shift",              Object_Type, 0, Array_shift },
-        { "slice",              Array_Type,  2, Array_slice },
-        { "sort",               Array_Type,  1, Array_sort },
-        { "splice",             Array_Type,  2, Array_splice },
-        { "unshift",            Number_Type, 1, Array_unshift },
-        { NULL }
-    };
-    return new Context::PrototypeFunctions(&arrayProtos[0]);
-}
-
-}
-}

mozilla/js2/src/jsarray.h

@@ -1,48 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-namespace JavaScript {    
-
-namespace JS2Runtime {
-
-
-    extern JSValue Array_Constructor(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc);
-    extern JSValue Array_concat(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc);
-
-    Context::PrototypeFunctions *getArrayProtos();
-
-
-
-}
-
-}

mozilla/js2/src/jsclasses.h

@@ -1,491 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-
-#ifndef jsclasses_h
-#define jsclasses_h
-
-#include "jstypes.h"
-
-namespace JavaScript {
-namespace JSClasses {
-
-    using JSTypes::JSValue;
-    using JSTypes::JSObject;
-    using JSTypes::JSType;
-    using JSTypes::JSScope;
-    using JSTypes::JSFunction;
-    using JSTypes::FunctionMap;
-    using ICG::ICodeModule;
-    
-
-    struct JSSlot {
-        typedef enum { kNoFlag = 0, kIsConstructor = 0x01, kIsVirtual = 0x02 } SlotFlags;   // <-- readonly, enumerable etc
-
-        // a slot may have a getter or a setter or both, but NOT either if mActual
-        JSType* mType;
-        uint32 mIndex;
-        SlotFlags mFlags;
-        JSFunction* mGetter;
-        JSFunction* mSetter;
-        bool mActual;
-        
-        JSSlot() : mType(0), mFlags(kNoFlag), mGetter(0), mSetter(0), mActual(true)
-        {
-        }
-
-        bool isConstructor() const          { return (mFlags & kIsConstructor) != 0; }
-        bool isVirtual() const              { return (mFlags & kIsVirtual) != 0; }
-    };
-
-    typedef gc_map_allocator(JSSlot) gc_slot_allocator;
-    typedef std::map<String, JSSlot, std::less<const String>, gc_slot_allocator> JSSlots;
-
-
-    typedef std::pair<String, JSFunction*> MethodEntry;
-    typedef std::vector<MethodEntry, gc_allocator<MethodEntry> > JSMethods;
-    typedef std::vector<JSFunction*, gc_allocator<JSFunction*> > JSFunctions;
-
-    struct JSOperator {
-        JSType *mOperand1;
-        JSType *mOperand2;
-        JSFunction *mFunction;
-        JSOperator(JSType *op1, JSType *op2, JSFunction *f) : mOperand1(op1), mOperand2(op2), mFunction(f) { }
-    };
-    typedef std::vector<JSOperator *, gc_allocator<JSOperator *> > JSOperatorList;
-
-
-    /**
-     * Represents a class in the JavaScript 2 (ECMA 4) language.
-     * Since a class defines a scope, and is defined in a scope,
-     * a new scope is created whose parent scope is the scope of
-     * class definition.
-     */
-    class JSClass : public JSType {
-
-    protected:
-        JSScope* mScope;        
-        uint32 mSlotCount;
-        JSSlots mSlots;
-        uint32 mStaticCount;
-        JSSlots mStaticSlots;
-        JSValue* mStaticData;
-        JSMethods mMethods;
-        bool mHasGetters;           // tracks whether any getters/setters get assigned
-        bool mHasSetters;
-        JSFunctions mGetters;       // allocated at 'complete()' time
-        JSFunctions mSetters;
-        JSOperatorList *mOperators[JSTypes::OperatorCount];
-    public:
-        JSClass(JSScope* scope, const String& name, JSClass* superClass = 0)
-            :   JSType(name, superClass),
-                mScope(new JSScope(scope)),
-                mSlotCount(superClass ? superClass->mSlotCount : 0),
-                mStaticCount(0),
-                mStaticData(0),
-                mHasGetters(false), mHasSetters(false), mGetters(0), mSetters(0)
-        {
-            if (superClass) {
-                   // inherit superclass methods
-                mMethods = JSMethods(superClass->mMethods);
-                   // and virtual fields
-                JSSlots::iterator sEnd = superClass->mSlots.end();
-                for (JSSlots::iterator si = superClass->mSlots.begin(); si != sEnd; si++)
-                    if (si->second.isVirtual())
-                        mSlots[si->first] = si->second;
-            }
-            for (uint32 i = 0; i < JSTypes::OperatorCount; i++)
-                mOperators[i] = NULL;
-        }
-        
-        JSClass* getSuperClass()
-        {
-            return static_cast<JSClass*>(mBaseType);
-        }
-        
-        JSScope* getScope()
-        {
-            return mScope;
-        }
-
-        const JSSlot& defineSlot(const String& name, JSType* type, JSSlot::SlotFlags flags = JSSlot::kNoFlag, JSFunction* getter = 0, JSFunction* setter = 0)
-        {
-            JSSlot& slot = mSlots[name];
-            slot.mType = type;
-            slot.mIndex = mSlotCount++; // starts at 0.
-            slot.mSetter = setter;
-            slot.mGetter = getter;
-            slot.mFlags = flags;
-            if (setter || getter)
-                slot.mActual = false;
-            return slot;
-        }
-
-        void setGetter(const String& name, JSFunction *getter, JSType* type)
-        {
-            JSSlots::iterator slti = mSlots.find(name);
-            if (slti == mSlots.end())
-                defineSlot(name, type, JSSlot::kNoFlag, getter, 0);
-            else {
-                ASSERT(!slti->second.mActual || slti->second.isVirtual());
-                ASSERT(slti->second.mGetter == 0);
-                slti->second.mGetter = getter;
-                slti->second.mActual = false;
-            }
-            mHasGetters = true;
-        }
-        
-        void setSetter(const String& name, JSFunction *setter, JSType* type)
-        {
-            JSSlots::iterator slti = mSlots.find(name);
-            if (slti == mSlots.end())
-                defineSlot(name, type, JSSlot::kNoFlag, 0, setter);
-            else {
-                JSSlot &s = slti->second;
-                ASSERT(!s.mActual || s.isVirtual());
-                ASSERT(s.mSetter == 0);
-                s.mSetter = setter;
-                s.mActual = false;
-            }
-            mHasSetters = true;
-        }
-        
-        bool hasGetter(const String& name)
-        {
-            JSSlots::iterator slti = mSlots.find(name);
-            return ((slti != mSlots.end()) && slti->second.mGetter);
-        }
-        
-        bool hasSetter(const String& name)
-        {
-            JSSlots::iterator slti = mSlots.find(name);
-            return ((slti != mSlots.end()) && slti->second.mSetter);
-        }
-        
-        bool hasGetter(uint32 index)
-        {
-            return (index < mGetters.size() && mGetters[index]);
-        }
-        
-        bool hasSetter(uint32 index)
-        {
-            return (index < mSetters.size() && mSetters[index]);
-        }
-        
-        JSFunction* getter(uint32 index)
-        {
-            return mGetters[index];
-        }
-        
-        JSFunction* setter(uint32 index)
-        {
-            return mSetters[index];
-        }
-        
-
-        const JSSlot& getSlot(const String& name)
-        {
-            return mSlots[name];
-        }
-        
-        bool hasSlot(const String& name)
-        {
-            return (mSlots.find(name) != mSlots.end());
-        }
-        
-        bool hasGetterOrSetter(const String& name)
-        {
-            return (mSlots.find(name) != mSlots.end());
-        }
-        
-        JSSlots& getSlots()
-        {
-            return mSlots;
-        }
-        
-        uint32 getSlotCount()
-        {
-            return mSlotCount;
-        }
-        
-        /**
-         * Define a static/class variable.
-         */
-        const JSSlot& defineStatic(const String& name, JSType* type)
-        {
-            JSSlot& slot = mStaticSlots[name];
-            ASSERT(slot.mType == 0);
-            slot.mType = type;
-            slot.mIndex = mStaticCount++;
-            return slot;
-        }
-
-        const JSSlot& defineConstructor(const String& name)
-        {
-            JSSlot& slot = mStaticSlots[name];
-            ASSERT(slot.mType == 0);
-            slot.mType = &JSTypes::Function_Type;
-            slot.mIndex = mStaticCount++;
-            slot.mFlags = JSSlot::kIsConstructor;
-            return slot;
-        }
-        
-        JSFunction *getDefaultConstructor()
-        {
-            if (hasStatic(mName)) {
-                const JSSlot &s = getStatic(mName);
-                ASSERT(s.isConstructor());
-                JSValue &v = (*this)[s.mIndex];
-                ASSERT(v.isFunction());
-                return v.function;
-            }
-            return NULL;
-        }
-
-        const JSSlot& getStatic(const String& name)
-        {
-            return mStaticSlots[name];
-        }
-        
-        bool hasStatic(const String& name, JSType*& type, bool &isConstructor)
-        {
-            JSSlots::const_iterator i = mStaticSlots.find(name);
-            if (i != mStaticSlots.end()) {
-                type = i->second.mType;
-                isConstructor = i->second.isConstructor();
-                return true;
-            }
-            return false;
-        }
-
-        bool hasStatic(const String& name)
-        {
-            return (mStaticSlots.find(name) != mStaticSlots.end());
-        }
-
-        bool complete()
-        {
-            if (mHasGetters || mHasSetters) {
-                if (mHasGetters) mGetters.resize(mSlotCount);
-                if (mHasSetters) mSetters.resize(mSlotCount);
-                JSSlots::iterator end = mSlots.end();
-                for (JSSlots::iterator i = mSlots.begin(); i != end; i++) {
-                    if (mHasGetters) mGetters[i->second.mIndex] = i->second.mGetter;
-                    if (mHasSetters) mSetters[i->second.mIndex] = i->second.mSetter;
-                }
-            }
-            mStaticData = new JSValue[mStaticCount];
-            return (mStaticData != 0);
-        }
-
-        JSValue& operator[] (uint32 index)
-        {
-            return mStaticData[index];
-        }
-        
-        virtual void printProperties(Formatter& f)
-        {
-            f << "Properties:\n";
-            JSObject::printProperties(f);
-            f << "Statics:\n";
-            printStatics(f);
-        }
-
-        void printStatics(Formatter& f)
-        {
-            JSClass* superClass = getSuperClass();
-            if (superClass) superClass->printStatics(f);
-            for (JSSlots::iterator i = mStaticSlots.begin(), end = mStaticSlots.end(); i != end; ++i) {
-                f << i->first << " : " << mStaticData[i->second.mIndex]  << "\n";
-            }
-        }
-
-        void defineOperator(JSTypes::Operator op, JSType *operand1, JSType *operand2, JSFunction *f)
-        {
-            if (!mOperators[op])
-                mOperators[op] = new JSOperatorList();
-            else {
-                for (JSOperatorList::iterator i = mOperators[op]->begin(), 
-                                    end = mOperators[op]->end(); i != end; ++i) {
-                    if (((*i)->mOperand1 == operand1)
-                            && ((*i)->mOperand2 == operand2)) {
-                        (*i)->mFunction = f;
-                        return;
-                    }
-                }
-            }                
-            mOperators[op]->push_back(new JSOperator(operand1, operand2, f));
-        }
-
-        void addApplicableOperators(JSOperatorList &list, JSTypes::Operator op, const JSType *operand1, const JSType *operand2)
-        {
-            if (mOperators[op]) {
-                for (JSOperatorList::iterator i = mOperators[op]->begin(), 
-                                    end = mOperators[op]->end(); i != end; ++i) {
-                    if (operand1->isSubTypeOf((*i)->mOperand1) && operand2->isSubTypeOf((*i)->mOperand2)) {
-                       list.push_back(*i);
-                    }
-                }
-            }
-        }
-
-        JSOperator *findUnaryOperator(JSTypes::Operator op)
-        {
-            if (mOperators[op])
-                return *mOperators[op]->begin();
-            else {
-                JSClass *super = getSuperClass();
-                if (super)
-                    return super->findUnaryOperator(op);
-                else
-                    return NULL;
-            }
-        }
-
-        void defineMethod(const String& name, JSFunction *f)
-        {
-            uint32 slot;
-            if (hasMethod(name, slot))
-                mMethods[slot] = MethodEntry(name, f);
-            else
-                mMethods.push_back(MethodEntry(name, f));
-        }
-
-        bool hasMethod(const String& name, uint32& index)
-        {
-            JSMethods::iterator end = mMethods.end();
-            for (JSMethods::iterator i = mMethods.begin(); i != end; i++) {
-                if (i->first == name) {
-                    index = static_cast<uint32>(i - mMethods.begin());
-                    return true;
-                }
-            }
-            return false;
-        }
-
-        JSFunction* getMethod(uint32 index)
-        {
-            return mMethods[index].second;
-        }
-    };
-
-    /**
-     * Represents an instance of a JSClass.
-     */
-    class JSInstance : public JSObject {
-    protected:
-        JSValue mSlots[1];
-    public:
-        void* operator new(size_t n, JSClass* thisClass)
-        {
-            uint32 slotCount = thisClass->getSlotCount();
-            if (slotCount > 0) n += sizeof(JSValue) * (slotCount - 1);
-            return gc_base::operator new(n);
-        }
-
-        void operator delete(void* /*ptr*/) {}
-        void operator delete(void* /*ptr*/, JSClass* /*thisClass*/) {}
-
-        JSInstance(JSClass* thisClass)
-        {
-            mType = thisClass;
-            // initialize extra slots with undefined.
-            uint32 slotCount = thisClass->getSlotCount();
-            if (slotCount > 0) {
-                std::uninitialized_fill(&mSlots[1], &mSlots[1] + (slotCount - 1),
-                                        JSTypes::kUndefinedValue);
-            }
-            // for grins, use the prototype link to access methods.
-            // setPrototype(thisClass->getScope());
-        }
-        
-        JSFunction* getMethod(uint32 index)
-        {
-            return getClass()->getMethod(index);
-        }
-
-        JSClass* getClass()
-        {
-            return static_cast<JSClass*>(mType);
-        }
-        
-        JSValue& operator[] (uint32 index)
-        {
-            return mSlots[index];
-        }
-
-        virtual void printProperties(Formatter& f)
-        {
-            f << "Properties:\n";
-            JSObject::printProperties(f);
-            f << "Slots:\n";
-            printSlots(f, getClass());
-        }
-
-        bool hasGetter(uint32 index)
-        {
-            return getClass()->hasGetter(index);
-        }
-        
-        bool hasSetter(uint32 index)
-        {
-            return getClass()->hasSetter(index);
-        }
-        
-        JSFunction* getter(uint32 index)
-        {
-            return getClass()->getter(index);
-        }
-
-        JSFunction* setter(uint32 index)
-        {
-            return getClass()->setter(index);
-        }
-
-
-    private:
-        void printSlots(Formatter& f, JSClass* thisClass)
-        {
-            JSClass* superClass = thisClass->getSuperClass();
-            if (superClass) printSlots(f, superClass);
-            JSSlots& slots = thisClass->getSlots();
-            for (JSSlots::iterator i = slots.begin(), end = slots.end(); i != end; ++i) {
-                f << i->first << " : " <<  mSlots[i->second.mIndex]  << "\n";
-            }
-        }
-    };
-    
-} /* namespace JSClasses */
-} /* namespace JavaScript */
-
-#endif /* jsclasses_h */

mozilla/js2/src/jsmath.cpp

@@ -1,261 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifdef _WIN32
- // Turn off warnings about identifiers too long in browser information
-#pragma warning(disable: 4786)
-#pragma warning(disable: 4711)
-#pragma warning(disable: 4710)
-#endif
-
-#include <algorithm>
-
-#include "parser.h"
-#include "numerics.h"
-#include "js2runtime.h"
-
-#include "jsmath.h"
-
-#include "fdlibm_ns.h"
-
-namespace JavaScript {    
-namespace JS2Runtime {
-
-#ifndef M_E
-#define M_E             2.7182818284590452354
-#endif
-#ifndef M_LOG2E
-#define M_LOG2E         1.4426950408889634074
-#endif
-#ifndef M_LOG10E
-#define M_LOG10E        0.43429448190325182765
-#endif
-#ifndef M_LN2
-#define M_LN2           0.69314718055994530942
-#endif
-#ifndef M_LN10
-#define M_LN10          2.30258509299404568402
-#endif
-#ifndef M_PI
-#define M_PI            3.14159265358979323846
-#endif
-#ifndef M_SQRT2
-#define M_SQRT2         1.41421356237309504880
-#endif
-#ifndef M_SQRT1_2
-#define M_SQRT1_2       0.70710678118654752440
-#endif
-#define M_CONSTANTS_COUNT     8
-
-
-static JSValue Math_abs(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    else
-        return JSValue(fd::fabs(argv[0].toNumber(cx).f64));
-}
-static JSValue Math_acos(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    return JSValue(fd::acos(argv[0].toNumber(cx).f64));
-}
-static JSValue Math_asin(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    return JSValue(fd::asin(argv[0].toNumber(cx).f64));
-}
-static JSValue Math_atan(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    return JSValue(fd::atan(argv[0].toNumber(cx).f64));
-}
-static JSValue Math_atan2(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc <= 1)
-        return kNaNValue;
-    float64 y = argv[0].toNumber(cx).f64;
-    float64 x = argv[1].toNumber(cx).f64;
-    return JSValue(fd::atan2(y, x));
-}
-static JSValue Math_ceil(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    return JSValue(fd::ceil(argv[0].toNumber(cx).f64));
-}
-static JSValue Math_cos(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    return JSValue(fd::cos(argv[0].toNumber(cx).f64));
-}
-static JSValue Math_exp(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    return JSValue(fd::exp(argv[0].toNumber(cx).f64));
-}
-static JSValue Math_floor(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    else
-        return JSValue(fd::floor(argv[0].toNumber(cx).f64));
-}
-static JSValue Math_log(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    return JSValue(fd::log(argv[0].toNumber(cx).f64));
-}
-static JSValue Math_max(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    float64 result = argv[0].toNumber(cx).f64;
-    for (uint32 i = 1; i < argc; ++i) {
-        float64 arg = argv[i].toNumber(cx).f64;
-        if (arg > result)
-            result = arg;
-    }
-    return JSValue(result);
-}
-static JSValue Math_min(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    float64 result = argv[0].toNumber(cx).f64;
-    for (uint32 i = 1; i < argc; ++i) {
-        float64 arg = argv[i].toNumber(cx).f64;
-        if (arg < result)
-            result = arg;
-    }
-    return JSValue(result);
-}
-static JSValue Math_pow(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc < 1)
-        return kNaNValue;
-    return JSValue(fd::pow(argv[0].toNumber(cx).f64, argv[1].toNumber(cx).f64));
-}
-static JSValue Math_random(Context * /*cx*/, const JSValue& /*thisValue*/, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    return JSValue(42.0);
-}
-static JSValue Math_round(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    float64 x = argv[0].toNumber(cx).f64;
-    return JSValue( fd::copysign( fd::floor(x + 0.5), x ) );
-}
-static JSValue Math_sin(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    return JSValue(fd::sin(argv[0].toNumber(cx).f64));
-}
-static JSValue Math_sqrt(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    if (argc == 0)
-        return kNaNValue;
-    return JSValue(fd::sqrt(argv[0].toNumber(cx).f64));
-}
-static JSValue Math_tan(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)   
-{
-    if (argc == 0)
-        return kNaNValue;
-    return JSValue(fd::tan(argv[0].toNumber(cx).f64));
-}
-
-
-struct {
-    char *name;
-    float64 value;
-} MathObjectConstants[M_CONSTANTS_COUNT] = {
-    { "E",      M_E },
-    { "LOG2E",  M_LOG2E },
-    { "LOG10E", M_LOG10E },
-    { "LN2",    M_LN2 },
-    { "LN10",   M_LN10 },
-    { "PI",     M_PI },
-    { "SQRT2",  M_SQRT2 },
-    { "SQRT1_2",M_SQRT1_2 }
-};
-
-struct MathObjectFunctionDef {
-    char *name;
-    JSFunction::NativeCode *imp;
-} MathObjectFunctions[] = {
-    { "abs",    Math_abs },
-    { "acos",   Math_acos },
-    { "asin",   Math_asin },
-    { "atan",   Math_atan },
-    { "atan2",  Math_atan2 },
-    { "ceil",   Math_ceil },
-    { "cos",    Math_cos },
-    { "exp",    Math_exp },
-    { "floor",  Math_floor },
-    { "log",    Math_log },
-    { "max",    Math_max },
-    { "min",    Math_min },
-    { "pow",    Math_pow },
-    { "random", Math_random },
-    { "round",  Math_round },
-    { "sin",    Math_sin },
-    { "sqrt",   Math_sqrt },
-    { "tan",    Math_tan },    
-};
-
-void initMathObject(Context *cx, JSObject *mathObj)
-{
-    uint32 i;
-    for (i = 0; i < M_CONSTANTS_COUNT; i++)
-        mathObj->defineVariable(cx, widenCString(MathObjectConstants[i].name), 
-                                    (NamespaceList *)(NULL), Number_Type, JSValue(MathObjectConstants[i].value));
-
-    for (i = 0; i < sizeof(MathObjectFunctions) / sizeof(MathObjectFunctionDef); i++) {
-        JSFunction *f = new JSFunction(MathObjectFunctions[i].imp, Number_Type);
-        mathObj->defineVariable(cx, widenCString(MathObjectFunctions[i].name), 
-                                    (NamespaceList *)(NULL), Number_Type, JSValue(f));
-    }
-}    
-
-
-
-}
-}

mozilla/js2/src/jsmath.h

@@ -1,41 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-namespace JavaScript {    
-namespace JS2Runtime {
-
-    void initMathObject(Context *cx, JSObject *mathObj);
-
-
-}
-}

mozilla/js2/src/jsstring.cpp

@@ -1,444 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifdef _WIN32
- // Turn off warnings about identifiers too long in browser information
-#pragma warning(disable: 4786)
-#pragma warning(disable: 4711)
-#pragma warning(disable: 4710)
-#endif
-
-#include <algorithm>
-
-#include "parser.h"
-#include "numerics.h"
-#include "js2runtime.h"
-
-#include "jsstring.h"
-
-namespace JavaScript {    
-namespace JS2Runtime {
-
-
-JSValue String_Constructor(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    JSValue thatValue = thisValue;
-    if (thatValue.isNull())
-        thatValue = String_Type->newInstance(cx);
-    ASSERT(thatValue.isObject());
-    JSObject *thisObj = thatValue.object;
-    ASSERT(dynamic_cast<JSStringInstance *>(thisObj));
-    JSStringInstance *strInst = (JSStringInstance *)thisObj;
-
-    if (argc > 0)
-        thisObj->mPrivate = (void *)(new String(*argv[0].toString(cx).string));
-    else
-        thisObj->mPrivate = (void *)(new String(widenCString("")));
-    strInst->mLength = ((String *)(thisObj->mPrivate))->size();
-    return thatValue;
-}
-
-JSValue String_fromCharCode(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
-{
-    String *resultStr = new String();
-    resultStr->reserve(argc);
-    for (uint32 i = 0; i < argc; i++)
-        *resultStr += (char16)(argv[i].toUInt16(cx).f64);
-
-    return JSValue(resultStr);
-}
-
-static JSValue String_toString(Context * /*cx*/, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    ASSERT(thisValue.isObject());
-    JSObject *thisObj = thisValue.object;
-    return JSValue((String *)thisObj->mPrivate);
-}
-
-struct MatchResult {
-    bool failure;
-    uint32 endIndex;
-    String **captures;
-};
-
-static void splitMatch(const String *S, uint32 q, const String *R, MatchResult &result)
-{
-    result.failure = true;
-    result.captures = NULL;
-
-    uint32 r = R->size();
-    uint32 s = S->size();
-    if ((q + r) > s)
-        return;
-    for (uint32 i = 0; i < r; i++) {
-        if ((*S)[q + i] != (*R)[i])
-            return;
-    }
-    result.endIndex = q + r;
-    result.failure = false;
-}
-
-static JSValue String_split(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ContextStackReplacement csr(cx);
-
-    ASSERT(thisValue.isObject());
-    JSValue S = thisValue.toString(cx);
-
-    JSArrayInstance *A = (JSArrayInstance *)Array_Type->newInstance(cx);
-    uint32 lim;
-    JSValue separatorV = (argc > 0) ? argv[0] : kUndefinedValue;
-    JSValue limitV = (argc > 1) ? argv[1] : kUndefinedValue;
-        
-    if (limitV.isUndefined())
-        lim = (uint32)(two32minus1);
-    else
-        lim = (uint32)(limitV.toUInt32(cx).f64);
-
-    uint32 s = S.string->size();
-    uint32 p = 0;
-
-    // XXX if separatorV.isRegExp() -->
-
-    const String *R = separatorV.toString(cx).string;
-
-    if (lim == 0) 
-        return JSValue(A);
-
-    if (separatorV.isUndefined()) {
-        A->setProperty(cx, widenCString("0"), NULL, S);
-        return JSValue(A);
-    }
-
-    if (s == 0) {
-        MatchResult z;
-        splitMatch(S.string, 0, R, z);
-        if (!z.failure)
-            return JSValue(A);
-        A->setProperty(cx, widenCString("0"), NULL, S);
-        return JSValue(A);
-    }
-    
-    while (true) {
-        uint32 q = p;
-step11:
-        if (q == s) {
-            String *T = new String(*S.string, p, (s - p));
-            JSValue v(T);
-            A->setProperty(cx, *numberToString(A->mLength), NULL, v);
-            return JSValue(A);
-        }
-        MatchResult z;
-        splitMatch(S.string, q, R, z);
-        if (z.failure) {
-            q = q + 1;
-            goto step11;
-        }
-        uint32 e = z.endIndex;
-        if (e == p) {
-            q = q + 1;
-            goto step11;
-        }
-        String *T = new String(*S.string, p, (q - p));
-        JSValue v(T);
-        A->setProperty(cx, *numberToString(A->mLength), NULL, v);
-        if (A->mLength == lim)
-            return JSValue(A);
-        p = e;
-        // step 20 --> 27, handle captures array (we know it's empty for non regexp)    
-    }
-
-}
-
-static JSValue String_valueOf(Context * /*cx*/, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    ASSERT(thisValue.isObject());
-    if (thisValue.isString())
-        return thisValue;
-    else
-        throw Exception(Exception::typeError, "String.valueOf called on");
-    return kUndefinedValue;
-}
-
-static JSValue String_charAt(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ASSERT(thisValue.isObject());
-    const String *str = thisValue.toString(cx).string;
-
-    uint32 pos = 0;
-    if (argc > 0)
-        pos = (uint32)(argv[0].toInt32(cx).f64);
-
-    if ((pos < 0) || (pos >= str->size()))
-        return JSValue(new String());       // have an empty string kValue somewhere?
-    else
-        return JSValue(new String(1, (*str)[pos]));
-    
-}
-
-static JSValue String_charCodeAt(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ASSERT(thisValue.isObject());
-    const String *str = thisValue.toString(cx).string;
-
-    uint32 pos = 0;
-    if (argc > 0)
-        pos = (uint32)(argv[0].toInt32(cx).f64);
-
-    if ((pos < 0) || (pos >= str->size()))
-        return kNaNValue;
-    else
-        return JSValue((float64)(*str)[pos]);
-}
-
-static JSValue String_concat(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ASSERT(thisValue.isObject());
-    const String *str = thisValue.toString(cx).string;
-    String *result = new String(*str);
-
-    for (uint32 i = 0; i < argc; i++) {
-        *result += *argv[i].toString(cx).string;
-    }
-
-    return JSValue(result);
-}
-
-static JSValue String_indexOf(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ASSERT(thisValue.isObject());
-    if (argc == 0)
-        return JSValue(-1.0);
-
-    const String *str = thisValue.toString(cx).string;
-    const String *searchStr = argv[0].toString(cx).string;
-    uint32 pos = 0;
-
-    if (argc > 1) {
-        int32 arg1 = (int32)(argv[1].toInt32(cx).f64);
-        if (arg1 < 0)
-            pos = 0;
-        else
-            if (toUInt32(arg1) >= str->size()) 
-                pos = str->size();
-            else
-                pos = toUInt32(arg1);
-    }
-    pos = str->find(*searchStr, pos);
-    if (pos == String::npos)
-        return JSValue(-1.0);
-    return JSValue((float64)pos);
-}
-
-static JSValue String_lastIndexOf(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ASSERT(thisValue.isObject());
-    if (argc == 0)
-        return JSValue(-1.0);
-
-    const String *str = thisValue.toString(cx).string;
-    const String *searchStr = argv[0].toString(cx).string;
-    uint32 pos = 0;
-
-    if (argc > 1) {
-        float64 fpos = argv[1].toNumber(cx).f64;
-        if (fpos != fpos) 
-            pos = str->size();
-        else {
-            int32 arg1 = (int32)(fpos);
-            if (arg1 < 0) 
-                pos = 0;
-            else
-                if (toUInt32(arg1) >= str->size()) 
-                    pos = str->size();
-                else
-                    pos = toUInt32(arg1);
-        }
-    }
-    pos = str->rfind(*searchStr, pos);
-    if (pos == String::npos)
-        return JSValue(-1.0);
-    return JSValue((float64)pos);
-}
-
-static JSValue String_localeCompare(Context * /*cx*/, const JSValue& /*thisValue*/, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    return kUndefinedValue;
-}
-
-static JSValue String_toLowerCase(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    ASSERT(thisValue.isObject());
-    JSValue S = thisValue.toString(cx);
-
-    String *result = new String(*S.string);
-    for (String::iterator i = result->begin(), end = result->end(); i != end; i++)
-        *i = toLower(*i);
-
-    return JSValue(result);
-}
-
-static JSValue String_toUpperCase(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
-{
-    ASSERT(thisValue.isObject());
-    JSValue S = thisValue.toString(cx);
-
-    String *result = new String(*S.string);
-    for (String::iterator i = result->begin(), end = result->end(); i != end; i++)
-        *i = toUpper(*i);
-
-    return JSValue(result);
-}
-
-static JSValue String_slice(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ASSERT(thisValue.isObject());
-    const String *sourceString = thisValue.toString(cx).string;
-
-    uint32 sourceLength = sourceString->size();
-    uint32 start, end;
-
-    if (argc > 0) {
-        int32 arg0 = (int32)(argv[0].toInt32(cx).f64);
-        if (arg0 < 0) {
-            arg0 += sourceLength;
-            if (arg0 < 0)
-                start = 0;
-            else
-                start = toUInt32(arg0);
-        }
-        else {
-            if (toUInt32(arg0) < sourceLength)
-                start = toUInt32(arg0);
-            else
-                start = sourceLength;
-        }            
-    }
-    else
-        start = 0;
-
-    if (argc > 1) {
-        int32 arg1 = (int32)(argv[1].toInt32(cx).f64);
-        if (arg1 < 0) {
-            arg1 += sourceLength;
-            if (arg1 < 0)
-                end = 0;
-            else
-                end = toUInt32(arg1);
-        }
-        else {
-            if (toUInt32(arg1) < sourceLength)
-                end = toUInt32(arg1);
-            else
-                end = sourceLength;
-        }            
-    }
-    else
-        end = sourceLength;
-
-    if (start > end)
-        return JSValue(new String());
-    return JSValue(new String(sourceString->substr(start, end - start)));
-}
-
-static JSValue String_substring(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
-{
-    ASSERT(thisValue.isObject());
-    const String *sourceString = thisValue.toString(cx).string;
-
-    uint32 sourceLength = sourceString->size();
-    uint32 start, end;
-
-    if (argc > 0) {
-        int32 arg0 = (int32)(argv[0].toInt32(cx).f64);
-        if (arg0 < 0)
-            start = 0;
-        else
-            if (toUInt32(arg0) < sourceLength)
-                start = toUInt32(arg0);
-            else
-                start = sourceLength;
-    }
-    else
-        start = 0;
-
-    if (argc > 1) {
-        int32 arg1 = (int32)(argv[1].toInt32(cx).f64);
-        if (arg1 < 0)
-            end = 0;
-        else
-            if (toUInt32(arg1) < sourceLength)
-                end = toUInt32(arg1);
-            else
-                end = sourceLength;
-    }
-    else
-        end = sourceLength;
-
-    if (start > end) {
-        uint32 t = start;
-        start = end;
-        end = t;
-    }
-        
-    return JSValue(new String(sourceString->substr(start, end - start)));
-}
-
-
-Context::PrototypeFunctions *getStringProtos()
-{
-    Context::ProtoFunDef stringProtos[] = 
-    {
-        { "toString",           String_Type, 0, String_toString },
-        { "valueof",            String_Type, 0, String_valueOf },
-        { "charAt",             String_Type, 1, String_charAt },
-        { "charCodeAt",         Number_Type, 1, String_charCodeAt },
-        { "concat",             String_Type, 1, String_concat },
-        { "indexOf",            Number_Type, 1, String_indexOf },
-        { "lastIndexOf",        Number_Type, 1, String_lastIndexOf },
-        { "localeCompare",      Number_Type, 1, String_localeCompare },
-        { "slice",              String_Type, 2, String_slice },
-        { "split",              Array_Type,  2, String_split },
-        { "substring",          String_Type, 2, String_substring },
-        { "toSource",           String_Type, 0, String_toString },
-        { "toLocaleUpperCase",  String_Type, 0, String_toUpperCase },  // (sic)
-        { "toLocaleLowerCase",  String_Type, 0, String_toLowerCase },  // (sic)
-        { "toUpperCase",        String_Type, 0, String_toUpperCase },
-        { "toLowerCase",        String_Type, 0, String_toLowerCase },
-        { NULL }
-    };
-    return new Context::PrototypeFunctions(&stringProtos[0]);
-}
-
-}
-}

mozilla/js2/src/jsstring.h

@@ -1,45 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-namespace JavaScript {    
-namespace JS2Runtime {
-
-
-    extern JSValue String_Constructor(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc);
-    extern JSValue String_fromCharCode(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc);
-
-    Context::PrototypeFunctions *getStringProtos();
-
-
-}
-}

mozilla/js2/src/jstypes.h

@@ -1,782 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef jstypes_h
-#define jstypes_h
-
-#include "utilities.h"
-#include "gc_allocator.h"
-#include "parser.h"
-#include <vector>
-#include <map>
-#include <stack>
-
-
-/* forward declare classes from JavaScript::ICG */
-namespace JavaScript {
-namespace ICG {
-    class ICodeModule;
-} /* namespace ICG */
-namespace Interpreter {
-    class Context;
-    struct Activation;
-} /* namespace Interpreter */
-} /* namespace JavaScript */
-
-namespace JavaScript {
-namespace JSTypes {
-
-    using ICG::ICodeModule;
-    using Interpreter::Context;
-    
-    class JSObject;
-    class JSArray;
-    class JSString;
-    class JSFunction;
-    class JSScope;
-    class JSType;
-    class Context;
-    
-    typedef uint32 Register;
-
-
-    /**
-     * All JavaScript data types.
-     */        
-    struct JSValue {
-        union {
-            int8 i8;
-            uint8 u8;
-            int16 i16;
-            uint16 u16;
-            int32 i32;
-            uint32 u32;
-            int64 i64;
-            uint64 u64;
-            float32 f32;
-            float64 f64;
-            JSObject* object;
-            JSArray* array;
-            JSFunction *function;
-            JSString *string;
-            JSType *type;
-            bool boolean;
-        };
-        
-        /* These are the ECMA types, for use in 'toPrimitive' calls */
-        enum ECMA_type {
-            Undefined, Null, Boolean, Number, Object, String, 
-            NoHint
-        };
-
-        typedef enum {
-            i8_tag, u8_tag,
-            i16_tag, u16_tag,
-            i32_tag, u32_tag,
-            i64_tag, u64_tag,
-            f32_tag, f64_tag,
-            integer_tag,
-            object_tag, array_tag, function_tag, string_tag, boolean_tag, type_tag,
-            undefined_tag, null_tag,
-            uninitialized_tag
-        } Tag;
-        Tag tag;
-        
-        JSValue() : f64(0.0), tag(undefined_tag) {}
-        explicit JSValue(int32 i32) : i32(i32), tag(i32_tag) {}
-        explicit JSValue(uint32 u32) : u32(u32), tag(u32_tag) {}
-        explicit JSValue(float64 f64) : f64(f64), tag(f64_tag) {}
-        explicit JSValue(JSObject* object) : object(object), tag(object_tag) {}
-        explicit JSValue(JSArray* array) : array(array), tag(array_tag) {}
-        explicit JSValue(JSFunction* function) : function(function), tag(function_tag) {}
-        explicit JSValue(JSString* string) : string(string), tag(string_tag) {}
-        explicit JSValue(bool boolean) : boolean(boolean), tag(boolean_tag) {}
-        explicit JSValue(JSType* type) : type(type), tag(type_tag) {}
-        explicit JSValue(Tag tag) : tag(tag) {}
-
-        int32& operator=(int32 i32)                     { return (tag = i32_tag, this->i32 = i32); }
-        uint32& operator=(uint32 u32)                   { return (tag = u32_tag, this->u32 = u32); }
-        float64& operator=(float64 f64)                 { return (tag = f64_tag, this->f64 = f64); }
-        JSObject*& operator=(JSObject* object)          { return (tag = object_tag, this->object = object); }
-        JSArray*& operator=(JSArray* array)             { return (tag = array_tag, this->array = array); }
-        JSFunction*& operator=(JSFunction* function)    { return (tag = function_tag, this->function = function); }
-        JSString*& operator=(JSString* string)          { return (tag = string_tag, this->string = string); }
-        bool& operator=(bool boolean)                   { return (tag = boolean_tag, this->boolean = boolean); }
-        JSType*& operator=(JSType* type)                { return (tag = type_tag, this->type = type); }
-        
-        bool isPrimitive() const                        { return (tag == i32_tag) || (tag == u32_tag) || (tag == f64_tag) || (tag == boolean_tag) || (tag == string_tag); }
-        bool isFunction() const                         { return (tag == function_tag); }
-        bool isArray() const                            { return (tag == array_tag); }
-        bool isObject() const                           { return ((tag == object_tag) || (tag == function_tag) || (tag == array_tag) || (tag == type_tag)); }
-        bool isString() const                           { return (tag == string_tag); }
-        bool isBoolean() const                          { return (tag == boolean_tag); }
-        bool isNumber() const                           { return (tag == f64_tag) || (tag == integer_tag); }
-
-                                                        /* this is correct wrt ECMA, The i32 & u32 kinds
-                                                           will have to be converted (to doubles?) anyway because
-                                                           we can't have overflow happening in generic arithmetic */
-
-        bool isInitialized() const                      { return (tag != uninitialized_tag); }
-        bool isUndefined() const                        { return (tag == undefined_tag); }
-        bool isNull() const                             { return (tag == null_tag); }
-        bool isNaN() const;
-        bool isNegativeInfinity() const;
-        bool isPositiveInfinity() const;
-        bool isNegativeZero() const;
-        bool isPositiveZero() const;
-        bool isType() const                             { return (tag == type_tag); }
-
-        JSValue toString(Context *cx) const             { return (isString() ? *this : valueToString(cx, *this)); }
-        JSValue toNumber() const                        { return (isNumber() ? *this : valueToNumber(*this)); }
-        JSValue toInt32() const                         { return ((tag == i32_tag) ? *this : valueToInt32(*this)); }
-        JSValue toUInt32() const                        { return ((tag == u32_tag) ? *this : valueToUInt32(*this)); }
-        JSValue toBoolean(Context *cx) const            { return ((tag == boolean_tag) ? *this : valueToBoolean(cx, *this)); }
-
-        JSValue toPrimitive(Context *cx, ECMA_type hint = NoHint) const;
-
-        JSValue convert(Context *cx, JSType *toType);
-
-        
-        static JSValue valueToString(Context *cx, const JSValue& value);
-        static JSValue valueToNumber(const JSValue& value);
-        static JSValue valueToInteger(const JSValue& value);
-        static JSValue valueToInt32(const JSValue& value);
-        static JSValue valueToUInt32(const JSValue& value);
-        static JSValue valueToBoolean(Context *cx, const JSValue& value);
-
-
-        const JSType *getType() const;                  // map from tag type to JS2 type
-        bool isSameType(const JSValue &other) const
-        {
-            const JSType *thisType = getType();
-            const JSType *otherType = other.getType();
-            if (thisType == otherType)
-                return true;
-            if (isNumber() && other.isNumber())
-                return true;
-            return false;
-        }
-
-        int operator==(const JSValue& value) const;
-    };
-
-    Formatter& operator<<(Formatter& f, const JSValue& value);
-
-    typedef enum {
-        None,
-        Posate,
-        Negate,
-        Complement,
-        Increment,
-        Decrement,
-        Const,
-        Call,
-        New,
-        NewArgs,
-        Index,
-        IndexEqual,
-        DeleteIndex,
-        Plus,
-        Minus,
-        Multiply,
-        Divide,
-        Remainder,
-        ShiftLeft,
-        ShiftRight,
-        UShiftRight,
-        Less,
-        LessEqual,
-        In,
-        Equal,
-        SpittingImage,
-        BitAnd,
-        BitXor,
-        BitOr,
-        OperatorCount
-    } Operator;
-
-
-#if defined(XP_MAC)
-    // copied from default template parameters in map.
-    //typedef gc_allocator<std::pair<const String, JSValue> > gc_map_allocator;
-    //typedef gc_allocator<std::pair<const String, JSValue> > gc_map_allocator;
-    #define gc_map_allocator(T) gc_allocator<std::pair<const String, T> >
-#elif defined(XP_UNIX)
-    // FIXME: in libg++, they assume the map's allocator is a byte allocator,
-    // which is wrapped in a simple_allocator. this is crap.
-    typedef char _Char[1];
-    //typedef gc_allocator<_Char> gc_map_allocator;
-    #define gc_map_allocator(T) gc_allocator<JSTypes::_Char>
-#elif defined(_WIN32)
-    // FIXME: MSVC++'s notion. this is why we had to add _Charalloc().
-    //typedef gc_allocator<JSValue> gc_map_allocator;
-    //typedef gc_allocator<JSContainer> gc_container_allocator;
-    #define gc_map_allocator(T) gc_allocator<T>
-#endif        
-        
-    /**
-     * GC-scannable array of values.
-     */
-    typedef std::vector<JSValue, gc_allocator<JSValue> > JSValues;
-
-
-    String getRegisterValue(const JSValues& registerList, Register reg);
-
-    extern const JSValue kUndefinedValue;
-    extern const JSValue kNaNValue;
-    extern const JSValue kTrueValue;
-    extern const JSValue kFalseValue;
-    extern const JSValue kNullValue;
-    extern const JSValue kNegativeZero;
-    extern const JSValue kPositiveZero;
-    extern const JSValue kNegativeInfinity;
-    extern const JSValue kPositiveInfinity;
-
-    // JS2 predefined types:
-    extern JSType           Object_Type;
-    extern JSType           Integer_Type;
-    extern JSType           Number_Type;
-    extern JSType           Character_Type;
-    extern JSType           String_Type;
-    extern JSType           Function_Type;
-    extern JSType           Array_Type;
-    extern JSType           Type_Type;
-    extern JSType           Boolean_Type;
-    extern JSType           Null_Type;
-    extern JSType           Void_Type;
-    extern JSType           None_Type;
-
-    // JS1X heritage classes as types:
-    extern JSType Date_Type;
-
-    typedef std::map<String, JSValue, std::less<String>, gc_map_allocator(JSValue) > JSProperties;
-    typedef std::map<String, JSFunction *, std::less<String> > FunctionMap;
-
-    /**
-     * Basic behavior of all JS objects, mapping a name to a value,
-     * with prototype-based inheritance.
-     */
-    class JSObject : public gc_base {
-    protected:
-        JSProperties mProperties;
-        FunctionMap *mGetter;      // only allocated if the object has properties with getters or setters
-        FunctionMap *mSetter;
-        JSObject* mPrototype;
-        JSType* mType;
-        JSString* mClass;       // this is the internal [[Class]] property
-
-
-        void *mPrivate;
-
-        static JSObject *initJSObject();
-        static JSString *ObjectString;
-        static JSObject *ObjectPrototypeObject;
-
-        void init(JSObject* prototype)  { mGetter = NULL; mSetter = NULL; mPrototype = prototype; mType = &Object_Type; mClass = ObjectString; }
-
-    public:
-        JSObject()                      { init(ObjectPrototypeObject); }
-        JSObject(JSValue &constructor)  { init(constructor.object->getProperty(widenCString("prototype")).object); }
-        JSObject(JSObject *prototype)   { init(prototype); }
-
-        virtual ~JSObject() 
-        {
-            if (mGetter) delete mGetter;
-            if (mSetter) delete mSetter;
-        }
-
-        void *getPrivate()                  { return mPrivate; }
-        void setPrivate(void *underwear)    { mPrivate = underwear; }
-    
-        static void initObjectObject(JSScope *g);
-
-        bool hasProperty(const String& name)
-        {
-            return (mProperties.count(name) != 0);
-        }
-
-        const JSValue& getProperty(const String& name)
-        {
-            JSProperties::const_iterator i = mProperties.find(name);
-            if (i != mProperties.end())
-                return i->second;
-            if (mPrototype)
-                return mPrototype->getProperty(name);
-            return kUndefinedValue;
-        }
-
-        JSValue& setProperty(const String& name, const JSValue& value)
-        {
-            return (mProperties[name] = value);
-        }
-        
-        void setGetter(const String& name, JSFunction *getter)
-        {
-            if (mGetter == NULL)
-                mGetter = new FunctionMap();
-            mProperties[name] = kUndefinedValue;
-            (*mGetter)[name] = getter;
-        }
-
-        void setSetter(const String& name, JSFunction *setter)
-        {
-            if (mSetter == NULL)
-                mSetter = new FunctionMap();
-            mProperties[name] = kUndefinedValue;
-            (*mSetter)[name] = setter;
-        }
-
-        JSFunction *getter(const String& name)
-        {
-            if (hasProperty(name)) {
-                if (mGetter) {
-                    FunctionMap::iterator g = mGetter->find(name);
-                    if (g != mGetter->end())
-                        return g->second;
-                }
-            }
-            else
-                if (mPrototype)
-                    return mPrototype->getter(name);
-            return NULL;
-        }
-
-        JSFunction *setter(const String& name)
-        {
-            if (hasProperty(name)) {
-                if (mSetter) {
-                    FunctionMap::iterator s = mSetter->find(name);
-                    if (s != mSetter->end())
-                        return s->second;
-                }
-            }
-            else
-                if (mPrototype)
-                    return mPrototype->setter(name);
-            return NULL;
-        }
-
-        const JSValue& deleteProperty(const String& name)
-        {
-            JSProperties::iterator i = mProperties.find(name);
-            if (i != mProperties.end()) {
-                mProperties.erase(i);
-                return kTrueValue;
-            }
-            if (mPrototype)
-                return mPrototype->deleteProperty(name);
-            return kFalseValue;
-        }
-
-        void setPrototype(JSObject* prototype)
-        {
-            mPrototype = prototype;
-        }
-        
-        JSObject* getPrototype()
-        {
-            return mPrototype;
-        }
-
-        JSType* getType()
-        {
-            return mType;
-        }
-
-        JSString* getClass()
-        {
-            return mClass;
-        }
-
-        void setClass(JSString* s)
-        {
-            mClass = s;
-        }
-
-        virtual void printProperties(Formatter& f);
-    };
-    
-    Formatter& operator<<(Formatter& f, JSObject& obj);
-
-    /**
-     * Private representation of a JavaScript array.
-     */
-    class JSArray : public JSObject {
-        static JSObject* ArrayPrototypeObject;
-        static JSString* ArrayString;
-
-        JSValues elements;
-        uint32 top;
-    public:
-
-        static JSFunction *Array_length_getter;
-        static void initArrayObject(JSScope *g);
-
-        JSArray() : JSObject(ArrayPrototypeObject), elements(1)                     { setClass(ArrayString); top = 0; }
-        JSArray(uint32 size) : JSObject(ArrayPrototypeObject), elements(size)       { setClass(ArrayString); top = size; }
-        JSArray(const JSValues &v) : JSObject(ArrayPrototypeObject), elements(v)    { setClass(ArrayString); }
-
-        uint32 length()
-        {
-            return top;
-        }
-            
-        JSValue& operator[](const JSValue& index)
-        {
-            // for now, we can only handle f64 index values.
-            uint32 n = (uint32)index.f64;
-            // obviously, a sparse representation might be better.
-            uint32 size = elements.size();
-            if (n >= size) expand(n, size);
-            markHiEnd(n);
-            return elements[n];
-        }
-            
-        JSValue& operator[](uint32 n)
-        {
-            // obviously, a sparse representation might be better.
-            uint32 size = elements.size();
-            if (n >= size) expand(n, size);
-            markHiEnd(n);
-            return elements[n];
-        }
-            
-        void resize(uint32 size)
-        {
-            elements.resize(size);
-            top = size;
-        }
-            
-    private:
-
-        void markHiEnd(uint32 index)
-        {
-            if ((index + 1) > top) top = index + 1;
-        }
-
-        void expand(uint32 n, uint32 size)
-        {
-            do {
-                size *= 2;
-            } while (n >= size);
-            elements.resize(size);
-        }
-    };
-        
-#if defined(XP_UNIX)
-    // bastring.cc defines a funky operator new that assumes a byte-allocator.
-    typedef string_char_traits<char16> JSCharTraits;
-    typedef gc_allocator<_Char> JSStringAllocator;
-#else
-    typedef std::char_traits<char16> JSCharTraits;
-    typedef gc_allocator<char16> JSStringAllocator;
-#endif
-
-    typedef std::basic_string<char16, JSCharTraits, JSStringAllocator> JSStringBase;
-
-    /**
-     * Garbage collectable UNICODE string.
-     */
-    class JSString : public JSStringBase, public gc_base {
-    public:
-        JSString() {}
-        explicit JSString(const JSStringBase& str) : JSStringBase(str) {}
-        explicit JSString(const JSStringBase* str) : JSStringBase(*str) {}
-        explicit JSString(const String& str);
-        explicit JSString(const String* str);
-        explicit JSString(const char* str);
-
-        operator String();
-
-        void append(const char* str);
-        void append(const JSStringBase* str);
-    };
-
-    class JSException : public gc_base {
-    public:
-        JSException(String mess) : value(JSValue(new JSString(mess))) { }
-        JSException(char *mess) : value(JSValue(new JSString(mess))) { }
-        JSException(JSValue v) : value(v) { }
-        JSValue value;
-    };
-    
-    inline Formatter& operator<<(Formatter& f, const JSString& str)
-    {
-        printString(f, str.begin(), str.end());
-        return f;
-    }
-
-    /**
-     * Private representation of a JS function. This simply
-     * holds a reference to the iCode module that is the
-     * compiled code of the function.
-     */
-    class JSFunction : public JSObject {
-    protected:
-        static JSString* FunctionString;
-        static JSObject* FunctionPrototypeObject;
-        ICodeModule* mICode;
-        typedef JavaScript::gc_traits_finalizable<JSFunction> traits;
-        typedef gc_allocator<JSFunction, traits> allocator;
-    public:
-        static void initFunctionObject(JSScope *g);
-
-        JSFunction() : mICode(0) {}
-
-        JSFunction(ICodeModule* iCode)
-            : JSObject(FunctionPrototypeObject),
-              mICode(iCode)
-        {
-            setClass(FunctionString);
-        }
-        virtual ~JSFunction();
-
-        virtual JSValue getThis()       { return kNullValue; }
-        virtual JSFunction *getFunky()  { return this; }
-    
-        void* operator new(size_t) { return allocator::allocate(1); }
-        ICodeModule* getICode()    { return mICode; }
-        virtual bool isNative()    { return false; }
-    };
-
-    class JSBoundThis : public JSFunction {
-        typedef JavaScript::gc_traits_finalizable<JSBoundThis> traits;
-        typedef gc_allocator<JSBoundThis, traits> allocator;
-    public:
-        JSBoundThis(JSValue aThis, JSFunction *aFunc) : mBoundThis(aThis), mFunction(aFunc) { }
-        JSValue mBoundThis;
-        JSFunction *mFunction;
-
-        virtual ~JSBoundThis()              { mICode = NULL; }
-        virtual JSValue getThis()           { return mBoundThis; }
-        virtual JSFunction *getFunky()      { return mFunction; }  
-        void* operator new(size_t) { return allocator::allocate(1); }
-    };
-
-    class JSNativeFunction : public JSFunction {
-        typedef JavaScript::gc_traits_finalizable<JSNativeFunction> traits;
-        typedef gc_allocator<JSNativeFunction, traits> allocator;
-    public:
-        typedef JSValue (*JSCode)(Context *cx, const JSValues& argv);
-        JSCode mCode;
-        JSNativeFunction(JSCode code) : mCode(code) {}
-        virtual bool isNative()    { return true; }
-        void* operator new(size_t) { return allocator::allocate(1); }
-    };
-        
-    class JSUnaryOperator : public JSFunction {
-        typedef JavaScript::gc_traits_finalizable<JSUnaryOperator> traits;
-        typedef gc_allocator<JSUnaryOperator, traits> allocator;
-    public:
-        typedef JSValue (*JSUnaryCode)(Context *cx, const JSValue& arg1);
-        JSUnaryCode mCode;
-        JSUnaryOperator(JSUnaryCode code) : mCode(code) {}
-        virtual bool isNative()    { return true; }
-        void* operator new(size_t) { return allocator::allocate(1); }
-    };
-
-    class JSBinaryOperator : public JSFunction {
-        typedef JavaScript::gc_traits_finalizable<JSBinaryOperator> traits;
-        typedef gc_allocator<JSBinaryOperator, traits> allocator;
-    public:
-        typedef JSValue (*JSBinaryCode)(Context *cx, const JSValue& arg1, const JSValue& arg2);
-        JSBinaryCode mCode;
-        JSBinaryOperator(JSBinaryCode code) : mCode(code) {}
-        virtual bool isNative()    { return true; }
-        void* operator new(size_t) { return allocator::allocate(1); }
-    };
-
-    class JSClosure : public JSFunction {
-        Interpreter::Activation *mActivation;
-        JSClosure *mPrevious;
-        typedef JavaScript::gc_traits_finalizable<JSClosure> traits;
-        typedef gc_allocator<JSClosure, traits> allocator;
-    public:
-        JSClosure(ICodeModule* iCode, Interpreter::Activation *activation, JSClosure *previous) 
-            : JSFunction(iCode), mActivation(activation), mPrevious(previous) {}
-
-        JSClosure* getPrevious()         { return mPrevious; }
-        Interpreter::Activation* getActivation()      { return mActivation; }
-        void* operator new(size_t) { return allocator::allocate(1); }
-    };
-
-   /**
-     * Provides a set of nested scopes. 
-     */
-    class JSScope : public JSObject {
-    protected:
-        JSScope* mParent;
-        JSProperties mTypes;
-    public:
-        JSScope(JSScope* parent = 0, JSObject* prototype = 0)
-            : mParent(parent)
-        {
-            if (prototype)
-                setPrototype(prototype);
-        }
-        
-        JSScope* getParent()
-        {
-            return mParent;
-        }
-    
-        bool isDefined(const String& name)
-        {
-            if (hasProperty(name))
-                return true;
-            if (mParent)
-                return mParent->isDefined(name);
-            return false;
-        }
-        
-        const JSValue& getVariable(const String& name)
-        {
-            const JSValue& ret = getProperty(name);
-            if (ret.isUndefined() && mParent) 
-                return mParent->getVariable(name);
-            return ret;
-        }
-        
-        JSValue& setVariable(const String& name, const JSValue& value)
-        {
-            return (mProperties[name] = value);
-        }
-        
-        JSValue& defineVariable(const String& name, JSType* type, const JSValue& value)
-        {
-            if (type != &Object_Type)
-                mTypes[name] = type;
-            return (mProperties[name] = value);
-        }
-
-        JSValue& defineVariable(const String& name, JSType* type)
-        {
-            if (type != &Object_Type)
-                mTypes[name] = type;
-            return (mProperties[name] = kUndefinedValue);
-        }
-
-        void setType(const String& name, JSType* type)
-        {
-            // only type variables that are defined in this scope.
-            JSProperties::iterator i = mProperties.find(name);
-            if (i != mProperties.end())
-                mTypes[name] = type;
-            else
-                if (mParent)
-                    mParent->setType(name, type);
-        }
-
-        JSType* getType(const String& name)
-        {
-            JSType* result = &Object_Type;
-            // only consider types for variables defined in this scope.
-            JSProperties::const_iterator i = mProperties.find(name);
-            if (i != mProperties.end()) {
-                i = mTypes.find(name);
-                if (i != mTypes.end())
-                    result = i->second.type;
-            } else {
-                // see if variable is defined in parent scope.
-                if (mParent)
-                    result = mParent->getType(name);
-            }
-            return result;
-        }
-        
-        JSValue& defineFunction(const String& name, ICodeModule* iCode)
-        {
-            JSValue value(new JSFunction(iCode));
-            return defineVariable(name, &Function_Type, value);
-        }
-
-        JSValue& defineNativeFunction(const String& name, JSNativeFunction::JSCode code)
-        {
-            JSValue value(new JSNativeFunction(code));
-            return defineVariable(name, &Function_Type, value);
-        }
-    };
-
-    class JSType : public JSObject {
-    protected:
-        String mName;
-        JSType *mBaseType;
-
-        // The constructor is an implementation of the [[Construct]] mechanism
-        JSFunction *mConstructor;
-        // The invokor is an implementation of the [[Call]] mechanism
-        JSFunction *mInvokor;
-    public:
-        JSType() { }
-        JSType(const String &name, JSType *baseType) : mName(name), mBaseType(baseType), mConstructor(NULL), mInvokor(NULL)
-        {
-            mType = &Type_Type;
-        }
-        
-        JSType(const String &name, JSType *baseType, JSFunction *constructor, JSFunction *invokor = NULL) 
-                    : mName(name), mBaseType(baseType), mConstructor(constructor), mInvokor(invokor)
-        {
-            mType = &Type_Type;
-        }
-
-        enum { NoRelation = 0x7FFFFFFF };
-
-        const String& getName() const { return mName; }
-
-        bool isSubTypeOf(const JSType *other) const;
-
-        int32 distance(const JSType *other) const;
-
-        JSFunction *getConstructor() const { return mConstructor; }
-        JSFunction *getInvokor() const { return mInvokor; }
-    };
-
-    class JSBoolean : public JSObject {
-    protected:
-        bool mValue;
-        static JSObject* BooleanPrototypeObject;
-        static JSString* BooleanString;
-    public:
-        JSBoolean(bool value) : JSObject(BooleanPrototypeObject), mValue(value) { setClass(BooleanString); }
-
-        static void initBooleanObject(JSScope *g);
-
-        bool getValue() { return mValue; }
-    };
-
-
-} /* namespace JSTypes */    
-} /* namespace JavaScript */
-
-
-#endif /* jstypes_h */

mozilla/js2/src/kitchensink.cpp

@@ -1,95 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#include <cstdlib>
-#include <cstring>
-#include "utilities.h"
-
-#ifdef WIN32
- #include <windows.h>
-#endif
-
-#ifdef XP_MAC
- #include <cstdarg>
- #include <Types.h>
-#endif
-
-namespace JS = JavaScript;
-
-
-
-
-//
-// Input
-//
-
-
-
-//
-// Output
-//
-
-
-
-//
-// Static Initializers
-//
-
-
-#ifndef _WIN32
-static void jsNewHandler()
-{
-    std::bad_alloc outOfMemory;
-    throw outOfMemory;
-}
-
-
-struct InitUtilities
-{
-    InitUtilities() {std::set_new_handler(&jsNewHandler);}
-};
-#else
-#include <new.h>
-static int jsNewHandler(size_t)
-{
-    std::bad_alloc outOfMemory;
-    throw outOfMemory;
-}
-
-
-struct InitUtilities
-{
-    InitUtilities() {_set_new_handler(&jsNewHandler);}
-};
-#endif
-InitUtilities initUtilities;

mozilla/js2/src/kitchensink.h

@@ -1,133 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s): 
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef kitchensink_h___
-#define kitchensink_h___
-
-#include <memory>
-#include <new>
-#include <string>
-#include <iterator>
-#include <algorithm>
-#include <cstdio>
-#include <cstdarg>
-
-#include "stlcfg.h"
-#include "systemtypes.h"
-#include "strings.h"
-#include "mem.h"
-
-
-namespace JavaScript {
-
-//
-// Alignment
-//
-
-        template<typename T>
-        struct AlignmentHelper {
-                char ch;
-                T t;
-        };
-        #define ALIGNMENT_OF(T) offsetof(JavaScript::AlignmentHelper<T>, t)
-
-
-
-        // Assign zero to n elements starting at first.
-        // This is equivalent ot fill_n(first, n, 0) but may be more efficient.
-        template<class ForwardIterator, class Size>
-        inline void zero_n(ForwardIterator first, Size n)
-        {
-                while (n) {
-                        *first = 0;
-                        ++first;
-                        --n;
-                }
-        }
-
-//
-// Linked Lists
-//
-
-        // In some cases it is desirable to manipulate ordinary C-style linked lists as though
-        // they were STL-like sequences.  These classes define STL forward iterators that walk
-        // through singly-linked lists of objects threaded through fields named 'next'.  The type
-        // parameter E must be a class that has a member named 'next' whose type is E* or const E*.
-
-        template <class E>
-        class ListIterator: public std::iterator<std::forward_iterator_tag, E> {
-                E *element;
-
-          public:
-                ListIterator() {}
-                explicit ListIterator(E *e): element(e) {}
-
-                E &operator*() const {return *element;}
-                E *operator->() const {return element;}
-                ListIterator &operator++() {element = element->next; return *this;}
-                ListIterator operator++(int) {ListIterator i(*this); element = element->next; return i;}
-                friend bool operator==(const ListIterator &i, const ListIterator &j) {return i.element == j.element;}
-                friend bool operator!=(const ListIterator &i, const ListIterator &j) {return i.element != j.element;}
-        };
-
-        
-        template <class E>
-  #ifndef _WIN32 // Microsoft VC6 bug: std::iterator should support five template arguments
-        class ConstListIterator: public std::iterator<std::forward_iterator_tag, E, ptrdiff_t, const E*, const E&> {
-  #else
-        class ConstListIterator: public std::iterator<std::forward_iterator_tag, E, ptrdiff_t> {
-  #endif
-                const E *element;
-
-          public:
-                ConstListIterator() {}
-                ConstListIterator(const ListIterator<E> &i): element(&*i) {}
-                explicit ConstListIterator(const E *e): element(e) {}
-
-                const E &operator*() const {return *element;}
-                const E *operator->() const {return element;}
-                ConstListIterator &operator++() {element = element->next; return *this;}
-                ConstListIterator operator++(int) {ConstListIterator i(*this); element = element->next; return i;}
-                friend bool operator==(const ConstListIterator &i, const ConstListIterator &j) {return i.element == j.element;}
-                friend bool operator!=(const ConstListIterator &i, const ConstListIterator &j) {return i.element != j.element;}
-        };
-
-
-//
-// Input
-//
-
-
-}
-
-#endif /* kitchensink_h___ */

mozilla/js2/src/lexer.cpp

@@ -1,717 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
-*
-* The contents of this file are subject to the Netscape Public
-* License Version 1.1 (the "License"); you may not use this file
-* except in compliance with the License. You may obtain a copy of
-* the License at http://www.mozilla.org/NPL/
-*
-* Software distributed under the License is distributed on an "AS
-* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
-* implied. See the License for the specific language governing
-* rights and limitations under the License.
-*
-* The Original Code is the JavaScript 2 Prototype.
-*
-* The Initial Developer of the Original Code is Netscape
-* Communications Corporation.   Portions created by Netscape are
-* Copyright (C) 1998 Netscape Communications Corporation. All
-* Rights Reserved.
-*
-* Contributor(s):
-*
-* Alternatively, the contents of this file may be used under the
-* terms of the GNU Public License (the "GPL"), in which case the
-* provisions of the GPL are applicable instead of those above.
-* If you wish to allow use of your version of this file only
-* under the terms of the GPL and not to allow others to use your
-* version of this file under the NPL, indicate your decision by
-* deleting the provisions above and replace them with the notice
-* and other provisions required by the GPL.  If you do not delete
-* the provisions above, a recipient may use your version of this
-* file under either the NPL or the GPL.
-*/
-
-#include "numerics.h"
-#include "lexer.h"
-
-namespace JS = JavaScript;
-
-
-// Create a new Lexer for lexing the provided source code.  The Lexer will
-// intern identifiers, keywords, and regular expressions in the designated
-// world.
-JS::Lexer::Lexer(World &world, const String &source, const String &sourceLocation, uint32 initialLineNum):
-        world(world), reader(source, sourceLocation, initialLineNum)
-{
-    nextToken = tokens;
-    nTokensFwd = 0;
-#ifdef DEBUG
-    nTokensBack = 0;
-#endif
-    lexingUnit = false;
-}
-
-
-// Skip past the next token, which must have been either peeked or read and then unread.
-// skip is faster than get but must not be called if the next token has not been seen yet.
-void JS::Lexer::skip()
-{
-    ASSERT(nTokensFwd);
-    if (++nextToken == tokens + tokenBufferSize)
-        nextToken = tokens;
-    --nTokensFwd;
-    DEBUG_ONLY(++nTokensBack);
-}
-
-
-// Get and return the next token.  The token remains valid until the next
-// call to this Lexer.  If the Reader reached the end of file, return a
-// Token whose Kind is end.  The caller may alter the value of this Token
-// (in particular, take control over the auto_ptr's data), but if it does so,
-// the caller is not allowed to unget this Token.
-//
-// If preferRegExp is true, a / will be preferentially interpreted as
-// starting a regular expression; otherwise, a / will be preferentially
-// interpreted as division or /=.
-const JS::Token &JS::Lexer::get(bool preferRegExp)
-{
-    const Token &t = peek(preferRegExp);
-    if (++nextToken == tokens + tokenBufferSize)
-        nextToken = tokens;
-    --nTokensFwd;
-    DEBUG_ONLY(++nTokensBack);
-    return t;
-}
-
-
-// Peek at the next token using the given preferRegExp setting.  If that
-// token's kind matches the given kind, consume that token and return it.
-// Otherwise, do not consume that token and return nil.
-const JS::Token *JS::Lexer::eat(bool preferRegExp, Token::Kind kind)
-{
-    const Token &t = peek(preferRegExp);
-    if (t.kind != kind)
-        return 0;
-    if (++nextToken == tokens + tokenBufferSize)
-        nextToken = tokens;
-    --nTokensFwd;
-    DEBUG_ONLY(++nTokensBack);
-    return &t;
-}
-
-
-// Return the next token without consuming it.
-//
-// If preferRegExp is true, a / will be preferentially interpreted as
-// starting a regular expression; otherwise, a / will be preferentially
-// interpreted as division or /=. A subsequent call to peek or get will
-// return the same token; that call must be presented with the same value
-// for preferRegExp.
-const JS::Token &JS::Lexer::peek(bool preferRegExp)
-{
-    // Use an already looked-up token if there is one.
-    if (nTokensFwd) {
-        ASSERT(savedPreferRegExp[nextToken - tokens] == preferRegExp);
-    } else {
-        lexToken(preferRegExp);
-        nTokensFwd = 1;
-#ifdef DEBUG
-        savedPreferRegExp[nextToken - tokens] = preferRegExp;
-        if (nTokensBack == tokenLookahead) {
-            nTokensBack = tokenLookahead-1;
-            if (tokenGuard)
-                (nextToken >= tokens+tokenLookahead ?
-                 nextToken-tokenLookahead :
-                 nextToken+tokenBufferSize-tokenLookahead)->valid = false;
-        }
-#endif
-    }
-    return *nextToken;
-}
-
-
-#ifdef DEBUG
-// Change the setting of preferRegExp for an already peeked token.
-// The token must not be one for which that setting mattered.
-//
-// THIS IS A DANGEROUS FUNCTION!
-// Use it only if you can be prove that the already peeked token does not
-// start with a slash.
-void JS::Lexer::redesignate(bool preferRegExp)
-{
-    if (nTokensFwd) {
-        ASSERT(savedPreferRegExp[nextToken - tokens] != preferRegExp);
-        ASSERT(!(nextToken->hasKind(Token::regExp) ||
-                 nextToken->hasKind(Token::divide) ||
-                 nextToken->hasKind(Token::divideEquals)));
-        savedPreferRegExp[nextToken - tokens] = preferRegExp;
-    }
-}
-#endif
-
-
-// Unread the last token.  This call may be called to unread at most
-// tokenBufferSize tokens at a time (where a peek also counts as temporarily
-// reading and unreading one token). When a token that has been unread is
-// peeked or read again, the same value must be passed in preferRegExp as for
-// the first time that token was read or peeked.
-void JS::Lexer::unget()
-{
-    ASSERT(nTokensBack--);
-    nTokensFwd++;
-    if (nextToken == tokens)
-        nextToken = tokens + tokenBufferSize;
-    --nextToken;
-}
-
-
-// Report a syntax error at the backUp-th last character read by the Reader.
-// In other words, if backUp is 0, the error is at the next character to be
-// read by the Reader; if backUp is 1, the error is at the last character
-// read by the Reader, and so forth.
-void JS::Lexer::syntaxError(const char *message, uint backUp)
-{
-    reader.unget(backUp);
-    reader.error(Exception::syntaxError, widenCString(message), reader.getPos());
-}
-
-
-// Get the next character from the reader, skipping any Unicode format-control
-// (Cf) characters.
-inline char16 JS::Lexer::getChar()
-{
-    char16 ch = reader.get();
-    if (char16Value(ch) >= firstFormatChar)
-        ch = internalGetChar(ch);
-    return ch;
-}
-
-
-// Helper for getChar()
-char16 JS::Lexer::internalGetChar(char16 ch)
-{
-    while (isFormat(ch))
-        ch = reader.get();
-    return ch;
-}
-
-
-// Peek the next character from the reader, skipping any Unicode
-// format-control (Cf) characters, which are read and discarded.
-inline char16 JS::Lexer::peekChar()
-{
-    char16 ch = reader.peek();
-    if (char16Value(ch) >= firstFormatChar)
-        ch = internalPeekChar(ch);
-    return ch;
-}
-
-
-// Helper for peekChar()
-char16 JS::Lexer::internalPeekChar(char16 ch)
-{
-    while (isFormat(ch)) {
-        reader.get();
-        ch = reader.peek();
-    }
-    return ch;
-}
-
-
-// Peek the next character from the reader, skipping any Unicode
-// format-control (Cf) characters, which are read and discarded.  If the
-// peeked character matches ch, read that character and return true;
-// otherwise return false.  ch must not be null.
-bool JS::Lexer::testChar(char16 ch)
-{
-    ASSERT(ch);     // If ch were null, it could match the eof null.
-    char16 ch2 = peekChar();
-    if (ch == ch2) {
-        reader.get();
-        return true;
-    }
-    return false;
-}
-
-
-// A backslash has been read.  Read the rest of the escape code.
-// Return the interpreted escaped character.  Throw an exception if the
-// escape is not valid. If unicodeOnly is true, allow only \uxxxx escapes.
-char16 JS::Lexer::lexEscape(bool unicodeOnly)
-{
-    char16 ch = getChar();
-    int nDigits;
-
-    if (!unicodeOnly || ch == 'u')
-        switch (ch) {
-          case '0':
-            // Make sure that the next character isn't a digit.
-            ch = peekChar();
-            if (!isASCIIDecimalDigit(ch))
-                return 0x00;
-            // Point to the next character in the error message
-            getChar();
-            break;
-
-          case 'b':
-            return 0x08;
-          case 'f':
-            return 0x0C;
-          case 'n':
-            return 0x0A;
-          case 'r':
-            return 0x0D;
-          case 't':
-            return 0x09;
-          case 'v':
-            return 0x0B;
-
-          case 'x':
-            nDigits = 2;
-            goto lexHex;
-          case 'u':
-            nDigits = 4;
-          lexHex:
-            {
-                uint32 n = 0;
-                while (nDigits--) {
-                    ch = getChar();
-                    uint digit;
-                    if (!isASCIIHexDigit(ch, digit))
-                        goto error;
-                    n = (n << 4) | digit;
-                }
-                return static_cast<char16>(n);
-            }
-          default:
-            if (!reader.getEof(ch)) {
-                CharInfo chi(ch);
-                if (!isAlphanumeric(chi) && !isLineBreak(chi))
-                    return ch;
-            }
-        }
-  error:
-    syntaxError("Bad escape code");
-    return 0;
-}
-
-
-// Read an identifier into s.  The initial value of s is ignored and cleared.
-// Return true if an escape code has been encountered.
-// If allowLeadingDigit is true, allow the first character of s to be a digit,
-// just like any continuing identifier character.
-bool JS::Lexer::lexIdentifier(String &s, bool allowLeadingDigit)
-{
-    reader.beginRecording(s);
-    bool hasEscape = false;
-
-    while (true) {
-        char16 ch = getChar();
-        char16 ch2 = ch;
-        if (ch == '\\') {
-            ch2 = lexEscape(true);
-            hasEscape = true;
-        }
-        CharInfo chi2(ch2);
-
-        if (!(allowLeadingDigit ? isIdContinuing(chi2) :
-              isIdLeading(chi2))) {
-            if (ch == '\\')
-                syntaxError("Identifier escape expands into non-identifier character");
-            else
-                reader.unget();
-            break;
-        }
-        reader.recordChar(ch2);
-        allowLeadingDigit = true;
-    }
-    reader.endRecording();
-    return hasEscape;
-}
-
-
-// Read a numeric literal into nextToken->chars and nextToken->value.
-// Return true if the numeric literal is followed by a unit, but don't read
-// the unit yet.
-bool JS::Lexer::lexNumeral()
-{
-    int hasDecimalPoint = 0;
-    String &s = nextToken->chars;
-    uint digit;
-
-    reader.beginRecording(s);
-    char16 ch = getChar();
-    if (ch == '0') {
-        reader.recordChar('0');
-        ch = getChar();
-        if ((ch&~0x20) == 'X') {
-            size_t pos = reader.getPos();
-            char16 ch2 = getChar();
-            if (isASCIIHexDigit(ch2, digit)) {
-                reader.recordChar(ch);
-                do {
-                    reader.recordChar(ch2);
-                    ch2 = getChar();
-                } while (isASCIIHexDigit(ch2, digit));
-                ch = ch2;
-            } else
-                reader.setPos(pos);
-            goto done;
-        } else if (isASCIIDecimalDigit(ch)) {
-            syntaxError("Numeric constant syntax error");
-        }
-    }
-    while (isASCIIDecimalDigit(ch) || ch == '.' && !hasDecimalPoint++) {
-        reader.recordChar(ch);
-        ch = getChar();
-    }
-    if ((ch&~0x20) == 'E') {
-        size_t pos = reader.getPos();
-        char16 ch2 = getChar();
-        char16 sign = 0;
-        if (ch2 == '+' || ch2 == '-') {
-            sign = ch2;
-            ch2 = getChar();
-        }
-        if (isASCIIDecimalDigit(ch2)) {
-            reader.recordChar(ch);
-            if (sign)
-                reader.recordChar(sign);
-            do {
-                reader.recordChar(ch2);
-                ch2 = getChar();
-            } while (isASCIIDecimalDigit(ch2));
-            ch = ch2;
-        } else
-            reader.setPos(pos);
-    }
-
-  done:
-    // At this point the reader is just past the character ch, which
-    // is the first non-formatting character that is not part of the
-    // number.
-    reader.endRecording();
-    const char16 *sBegin = s.data();
-    const char16 *sEnd = sBegin + s.size();
-    const char16 *numEnd;
-    nextToken->value = stringToDouble(sBegin, sEnd, numEnd);
-    ASSERT(numEnd == sEnd);
-    reader.unget();
-    ASSERT(ch == reader.peek());
-    return isIdContinuing(ch) || ch == '\\';
-}
-
-
-// Read a string literal into s.  The initial value of s is ignored and
-// cleared. The opening quote has already been read into separator.
-void JS::Lexer::lexString(String &s, char16 separator)
-{
-    char16 ch;
-
-    reader.beginRecording(s);
-    while ((ch = reader.get()) != separator) {
-        CharInfo chi(ch);
-        if (!isFormat(chi)) {
-            if (ch == '\\')
-                ch = lexEscape(false);
-            else if (reader.getEof(ch) || isLineBreak(chi))
-                syntaxError("Unterminated string literal");
-            reader.recordChar(ch);
-        }
-    }
-    reader.endRecording();
-}
-
-
-// Read a regular expression literal.  Store the regular expression in
-// nextToken->id and the flags in nextToken->chars.
-// The opening slash has already been read.
-void JS::Lexer::lexRegExp()
-{
-    String s;
-    char16 prevCh = 0;
-
-    reader.beginRecording(s);
-    while (true) {
-        char16 ch = getChar();
-        CharInfo chi(ch);
-        if (reader.getEof(ch) || isLineBreak(chi))
-            syntaxError("Unterminated regular expression literal");
-        if (prevCh == '\\') {
-            reader.recordChar(ch);
-            // Ignore slashes and backslashes immediately after a backslash
-            prevCh = 0;
-        } else if (ch != '/') {
-            reader.recordChar(ch);
-            prevCh = ch;
-        } else
-            break;
-    }
-    reader.endRecording();
-    nextToken->id = &world.identifiers[s];
-
-    lexIdentifier(nextToken->chars, true);
-}
-
-
-// Read a token from the Reader and store it at *nextToken.
-// If the Reader reached the end of file, store a Token whose Kind is end.
-void JS::Lexer::lexToken(bool preferRegExp)
-{
-    Token &t = *nextToken;
-    t.lineBreak = false;
-    t.id = 0;
-    // Don't really need to waste time clearing this string here
-    //clear(t.chars);
-    Token::Kind kind;
-
-    if (lexingUnit) {
-        lexIdentifier(t.chars, false);
-        ASSERT(t.chars.size());
-        kind = Token::unit;   // unit
-        lexingUnit = false;
-    } else {
-      next:
-        char16 ch = reader.get();
-        if (reader.getEof(ch)) {
-          endOfInput:
-            t.pos = reader.getPos() - 1;
-            kind = Token::end;
-        } else {
-            char16 ch2;
-            CharInfo chi(ch);
-
-            switch (cGroup(chi)) {
-              case CharInfo::FormatGroup:
-              case CharInfo::WhiteGroup:
-                goto next;
-
-              case CharInfo::IdGroup:
-                t.pos = reader.getPos() - 1;
-              readIdentifier:
-                {
-                    reader.unget();
-                    String s;
-                    bool hasEscape = lexIdentifier(s, false);
-                    t.id = &world.identifiers[s];
-                    kind = hasEscape ? Token::identifier : t.id->tokenKind;
-                }
-                break;
-
-              case CharInfo::NonIdGroup:
-              case CharInfo::IdContinueGroup:
-                t.pos = reader.getPos() - 1;
-                switch (ch) {
-                  case '(':
-                    kind = Token::openParenthesis;  // (
-                    break;
-                  case ')':
-                    kind = Token::closeParenthesis; // )
-                    break;
-                  case '[':
-                    kind = Token::openBracket;      // [
-                    break;
-                  case ']':
-                    kind = Token::closeBracket;     // ]
-                    break;
-                  case '{':
-                    kind = Token::openBrace;        // {
-                    break;
-                  case '}':
-                    kind = Token::closeBrace;       // }
-                    break;
-                  case ',':
-                    kind = Token::comma;            // ,
-                    break;
-                  case ';':
-                    kind = Token::semicolon;        // ;
-                    break;
-                  case '.':
-                    kind = Token::dot;              // .
-                    ch2 = getChar();
-                    if (isASCIIDecimalDigit(ch2)) {
-                        reader.setPos(t.pos);
-                        goto number;                // decimal point
-                    } else if (ch2 == '.') {
-                        kind = Token::doubleDot;    // ..
-                        if (testChar('.'))
-                            kind = Token::tripleDot;// ...
-                    } else
-                        reader.unget();
-                    break;
-                  case ':':
-                    kind = Token::colon;            // :
-                    if (testChar(':'))
-                        kind = Token::doubleColon;  // ::
-                    break;
-                  case '#':
-                    kind = Token::pound;            // #
-                    break;
-                  case '@':
-                    kind = Token::at;               // @
-                    break;
-                  case '?':
-                    kind = Token::question;         // ?
-                    break;
-
-                  case '~':
-                    kind = Token::complement;       // ~
-                    break;
-                  case '!':
-                    kind = Token::logicalNot;       // !
-                    if (testChar('=')) {
-                        kind = Token::notEqual;     // !=
-                        if (testChar('='))
-                            kind = Token::notIdentical; // !==
-                    }
-                    break;
-
-                  case '*':
-                    kind = Token::times;            // * *=
-                  tryAssignment:
-                    if (testChar('='))
-                        kind = Token::Kind(kind + Token::timesEquals - Token::times);
-                    break;
-
-                  case '/':
-                    kind = Token::divide;           // /
-                    ch = getChar();
-                    if (ch == '/') {                // // comment
-                        do {
-                            ch = reader.get();
-                            if (reader.getEof(ch))
-                                goto endOfInput;
-                        } while (!isLineBreak(ch));
-                        goto endOfLine;
-                    } else if (ch == '*') {         // /*comment*/
-                        ch = 0;
-                        do {
-                            ch2 = ch;
-                            ch = getChar();
-                            if (isLineBreak(ch)) {
-                                reader.beginLine();
-                                t.lineBreak = true;
-                            } else if (reader.getEof(ch))
-                                syntaxError("Unterminated /* comment");
-                        } while (ch != '/' || ch2 != '*');
-                        goto next;
-                    } else {
-                        reader.unget();
-                        if (preferRegExp) {         // Regular expression
-                            kind = Token::regExp;
-                            lexRegExp();
-                        } else
-                            goto tryAssignment;     // /=
-                    }
-                    break;
-
-                  case '%':
-                    kind = Token::modulo;           // %
-                    goto tryAssignment;             // %=
-
-                  case '+':
-                    kind = Token::plus;             // +
-                    if (testChar('+'))
-                        kind = Token::increment;    // ++
-                    else
-                        goto tryAssignment;         // +=
-                    break;
-
-                  case '-':
-                    kind = Token::minus;            // -
-                    ch = getChar();
-                    if (ch == '-')
-                        kind = Token::decrement;    // --
-                    else if (ch == '>')
-                        kind = Token::arrow;        // ->
-                    else {
-                        reader.unget();
-                        goto tryAssignment;         // -=
-                    }
-                    break;
-
-                  case '&':
-                    kind = Token::bitwiseAnd;       // & && &= &&=
-                  logical:
-                    if (testChar(ch))
-                        kind = Token::Kind(kind - Token::bitwiseAnd + Token::logicalAnd);
-                    goto tryAssignment;
-                  case '^':
-                    kind = Token::bitwiseXor;       // ^ ^^ ^= ^^=
-                    goto logical;
-                  case '|':
-                    kind = Token::bitwiseOr;        // | || |= ||=
-                    goto logical;
-
-                  case '=':
-                    kind = Token::assignment;       // =
-                    if (testChar('=')) {
-                        kind = Token::equal;        // ==
-                        if (testChar('='))
-                            kind = Token::identical; // ===
-                    }
-                    break;
-
-                  case '<':
-                    kind = Token::lessThan;         // <
-                    if (testChar('<')) {
-                        kind = Token::leftShift;    // <<
-                        goto tryAssignment;         // <<=
-                    }
-                  comparison:
-                    if (testChar('='))              // <= >=
-                        kind = Token::Kind(kind + Token::lessThanOrEqual - Token::lessThan);
-                    break;
-                  case '>':
-                    kind = Token::greaterThan;      // >
-                    if (testChar('>')) {
-                        kind = Token::rightShift;   // >>
-                        if (testChar('>'))
-                            kind = Token::logicalRightShift; // >>>
-                        goto tryAssignment;         // >>= >>>=
-                    }
-                    goto comparison;
-
-                  case '\\':
-                    goto readIdentifier;            // An identifier that starts with an escape
-
-                  case '\'':
-                  case '"':
-                    kind = Token::string;           // 'string' "string"
-                    lexString(t.chars, ch);
-                    break;
-
-                  case '0':
-                  case '1':
-                  case '2':
-                  case '3':
-                  case '4':
-                  case '5':
-                  case '6':
-                  case '7':
-                  case '8':
-                  case '9':
-                    reader.unget();                 // Number
-                  number:
-                    kind = Token::number;
-                    lexingUnit = lexNumeral();
-                    break;
-
-                  default:
-                    syntaxError("Bad character");
-                }
-                break;
-
-              case CharInfo::LineBreakGroup:
-              endOfLine:
-                reader.beginLine();
-                t.lineBreak = true;
-                goto next;
-            }
-        }
-    }
-    t.kind = kind;
-#ifdef DEBUG
-    t.valid = true;
-#endif
-}

mozilla/js2/src/lexer.h

@@ -1,105 +0,0 @@
-/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
- *
- * The contents of this file are subject to the Netscape Public
- * License Version 1.1 (the "License"); you may not use this file
- * except in compliance with the License. You may obtain a copy of
- * the License at http://www.mozilla.org/NPL/
- *
- * Software distributed under the License is distributed on an "AS
- * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
- * implied. See the License for the specific language governing
- * rights and limitations under the License.
- *
- * The Original Code is the JavaScript 2 Prototype.
- *
- * The Initial Developer of the Original Code is Netscape
- * Communications Corporation.  Portions created by Netscape are
- * Copyright (C) 1998 Netscape Communications Corporation. All
- * Rights Reserved.
- *
- * Contributor(s):
- *
- * Alternatively, the contents of this file may be used under the
- * terms of the GNU Public License (the "GPL"), in which case the
- * provisions of the GPL are applicable instead of those above.
- * If you wish to allow use of your version of this file only
- * under the terms of the GPL and not to allow others to use your
- * version of this file under the NPL, indicate your decision by
- * deleting the provisions above and replace them with the notice
- * and other provisions required by the GPL.  If you do not delete
- * the provisions above, a recipient may use your version of this
- * file under either the NPL or the GPL.
- */
-
-#ifndef lexer_h___
-#define lexer_h___
-
-#include "utilities.h"
-#include "formatter.h"
-#include "reader.h"
-#include "token.h"
-#include "world.h"
-
-namespace JavaScript
-{
-    class Lexer {
-        enum {tokenLookahead = 2};      // Number of tokens that can be simultaneously live
-#ifdef DEBUG
-        enum {tokenGuard = 10};         // Number of invalid tokens added to circular token buffer to catch references to old tokens
-#else
-        enum {tokenGuard = 0};          // Number of invalid tokens added to circular token buffer to catch references to old tokens
-#endif
-        // Token lookahead buffer size
-        enum {tokenBufferSize = tokenLookahead + tokenGuard};
-
-        Token tokens[tokenBufferSize];  // Circular buffer of recently read or lookahead tokens
-        Token *nextToken;               // Address of next Token in the circular buffer to be returned by get()
-        int nTokensFwd;                 // Net number of Tokens on which unget() has been called; these Tokens are ahead of nextToken
-#ifdef DEBUG
-        int nTokensBack;                // Number of Tokens on which unget() can be called; these Tokens are beind nextToken
-        bool savedPreferRegExp[tokenBufferSize]; // Circular buffer of saved values of preferRegExp to get() calls
-#endif
-        bool lexingUnit;                // True if lexing a unit identifier immediately following a number
-      public:
-        World &world;
-        Reader reader;
-
-        Lexer(World &world, const String &source, const String &sourceLocation, uint32 initialLineNum = 1);
-
-        void skip();
-        const Token &get(bool preferRegExp);
-        const Token *eat(bool preferRegExp, Token::Kind kind);
-        const Token &peek(bool preferRegExp);
-        void redesignate(bool preferRegExp);
-        void unget();
-        size_t getPos() const;
-
-      private:
-        void syntaxError(const char *message, uint backUp = 1);
-        char16 getChar();
-        char16 internalGetChar(char16 ch);
-        char16 peekChar();
-        char16 internalPeekChar(char16 ch);
-        bool testChar(char16 ch);
-
-        char16 lexEscape(bool unicodeOnly);
-        bool lexIdentifier(String &s, bool allowLeadingDigit);
-        bool lexNumeral();
-        void lexString(String &s, char16 separator);
-        void lexRegExp();
-        void lexToken(bool preferRegExp);
-    };
-
-
-#ifndef DEBUG
-    inline void Lexer::redesignate(bool) {}  // See description for the DEBUG version inside lexer.cpp
-#endif
-
-    // Return the position of the first character of the next token, which must have been peeked.
-    inline size_t Lexer::getPos() const
-    {
-        ASSERT(nTokensFwd);
-        return nextToken->getPos();
-    }
-}
-#endif /* lexer_h___ */